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PREFACE 


It  was  necessary  to  analyze  a large  amount  of  human  response  data  in  order 
to  establish  quantitative  measures  that  evaluate  fidelity  of  head  response  in  an 
anthropomorphic  dummy.  To  facilitate  this  work,  software  was  developed  to 
automate  the  data  processing  on  the  VAX  computer  of  the  National  Highway 
Traffic  Safety  Administration.  This  volume  is  a guide  to  the  use  of  that  software. 

The  software  was  developed  under  the  direction  of  Dr.  C.  H.  Spenny 
formerly  of  the  Transportation  Systems  Center  (TSC),  by  Messrs.  J.  Burstein,  D.  A. 
Gordon,  T.  Peters  and  R.  Stevens  of  the  Systems  Development  Corporation,  an  on- 
site ADP  contractor  at  TSC. 
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1.  INTRODUCTION 


The  data  retrieval,  analysis  and  display  software  described  in  this  volume 
consists  of  a general  purpose  data  manipulation  program,  the  Data  Retrieval  and 
Display  (DRD)  program,  and  a pair  of  specialized  analysis  programs,  HEAD  and 
NECK. 


The  DRD  program  is  user  friendly  and  is  designed  to  quickly  and  efficiently 
retrieve  and  graphically  display  data  on  head  and  neck  response.  As  currently 
programmed  it  can  be  used  with  the  test  data  from  the  Naval  Biodynamics 
Laboratory,  Wayne  State  University  (WSU),  and  the  University  of  Michigan 
Transportation  Research  Institute  (UMTRI)  that  is  tabulated  in  this  volume.  This 
data  base  consists  of  380  tests. 

HEAD  and  NECK  are  specialized  programs  written  for  use  at  the 
Transportation  Systems  Center  in  analysis  of  head  and  neck  response.  The  response 
variables  that  are  calculated  by  these  programs  are  integrated  with  the  test  data 
and  displayed  using  the  DRD  program. 

Figure  1-1  is  a block  diagram  representation  of  the  software.  All  software  is 
written  in  Fortran  for  operation  on  a VAX/VMS  computer.  The  Fortran  coding  is 
included  as  Appendix  C of  this  volume. 


FIGURE  1-1.  BLOCK  DIAGRAM  REPRESENTATION  OF  THE  DATA  RETRIEVAL, 
ANALYSIS  AND  DISPLAY  SOFTWARE 
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2.  PROGRAMS  FOR  DATA  RETRIEVAL  AND  DISPLAY  (DRD) 


2.1  DESCRIPTION 

The  user  may  retrieve  any  of  the  variables  (records)  from  the  run  files  that 
reside  in  disk  storage.  These  variables  are  selected  by  specifying  the  run  number 
and  variable  name  for  each  variable  requested.  The  variables  that  may  be 
retrieved  are  those  listed  in  Appendix  A of  this  volume.  The  total  number  of  test 
variables  is  92. 

To  reduce  disk  storage  requirements,  the  run  files  are  written  in  binary 
format  and  each  run  includes  only  66  of  the  test  variables.  The  data  that  is  not 
present  consists  of;  (1)  linear  velocity  data  derived  from  photography,  and  (2)  linear 
velocity  and  displacement  data  as  derived  from  sensor  (accelerometer) 
measurements.  When  the  user  requests  one  of  the  variables  not  present,  it  is 
reconstructed  by  differentiating  photographic  displacement  or  integrating  sensor 
acceleration,  as  appropriate.  This  operation  is  transparent  to  the  user  and 
reproduces  the  test  results  to  six  significant  figures. 

Each  run  file  consists  of  a series  of  records,  the  first  being  a header  record 
which  contains  the  run  number,  subject  number  and  other  parameters  describing 
the  overall  test.  The  header  record  is  followed  by  the  66  records  of  stored 
variables.  Each  sensor  (accelerometer)  record  has  the  same  format,  consisting  of 
598  fields  of  test  data.  All  NBDL  sensor  measurements  were  taken  at  .0005  sec 
timesteps,  thus  allowing  the  storage  of  response  data  for  just  under  0.3  sec.  Sensor 
data  is  not  available  for  the  Wayne  State  and  UMTRI  data. 

Each  photographic  record  within  a run  is  identical  in  format  and  size. 
However,  the  number  of  fields  varies  from  run  to  run  and  is  determined  by  the 
number  of  frames  digitized.  In  addition,  the  time  step  varies  between  runs  as 
determined  by  camera  speed.  One  of  the  photographic  records  is  the  variable, 
TIME,  whose  field  entries  are  the  times  of  occurrence  of  film  frames  which  were 
digitized. 

Data  records  requested  by  the  user,  up  to  a maximum  of  100,  are  extracted 
into  a scratch  file.  The  scratch  file  is  binary  and  becomes  the  source  file  for  use 
by  other  portions  of  the  DRD  program  and  by  HEAD  and  NECK.  DRD  capabilities, 
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in  addition  to  data  extraction,  include:  (1)  filing  and  retrieving  scratch  files,  (2) 
creation  of  new  variables  by  performing  basic  mathematical  operations  on  one  or 
more  variables  in  the  scratch  file,  and  (3)  graphic  display.  Use  of  the  DRD 
capabilities  is  described  in  Section  2.2  which  follows. 

It  should  be  noted  that  the  graphic  display  module  recognizes  sensor  and 
photographic  variables  and  correctly  plots  them  versus  time,  even  on  the  same 
graph.  However,  there  are  no  program  checks  to  prevent  the  creation  of  illogical 
new  variables.  In  particular,  the  user  is  cautioned  against  combining  (and  cross 
plotting)  photographic  and  sensor  variables. 

2.2  USE  OF  THE  DRD  PROGRAM 

To  use  the  DRD  program  issue  the  VAX/VMS  DCL  command; 


The  program  will  issue  a prompt  ( XTR>)  and  expect  the  user  to  type  in  one  of 
the  following  commands; 


The  first  three  characters  of  each  command  must  be  entered.  The  remaining 
characters  are  optional.  The  following  sections  describe  the  syntax  of  each  of 
these  commands. 

2.2.1  CLEAR  Command 


This  command  sets  the  number  of  entries  in  the  directory  to  zero.  The 
scratch  file  is  thus  cleared  and  contains  no  data  records.  This  command  should  be 
used  before  a new  scratch  file  is  made  up,  or  to  clear  the  file  in  case  errors  are 
made  during  data  extraction. 


$ RUN  TSCPROG.SRC.PROGS.NECK.ANALYSIS  XTRAC 


CLEAR 

EXTRACT 

DIRECTORY 

FILE 

GET 


END 

ADD 

SUBTRACT 

VMAGNITUDE 

DIVIDE 


NORMALIZE 

STANDEV 

DSPLAY 
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. 

The  use  of  the  optional  V with  this  command  sets  the  number  of  entries  in 
the  directory  to  the  integer  value  'n',  allowing  the  user  better  control  over  the 
extracted  data  file.  The  default  value  when  V is  not  specified  is  100.  The  user 
can  extract  variables,  produce  new  variables  (seen  in  the  following  sections)  and 
overwrite  these  variables  if  results  are  unsatisfactory. 

XTR>  CLEAR  or 
XTR>  CLEAR  20 

2.2.2  EXTRACT  Command 

This  command  is  used  to  extract  records  from  the  original  binary  format 
files.  These  records  are  then  written  to  a random  access  file  named 
SCRTCH.DAT.  Individual  tests  are  identified  by  run  number  and  individual 
variables  are  identified  by  variable  name.  The  keyword  'ALL'  may  be  used  in  place 
of  a variable  name  to  extract  all  variables  of  any  given  run.  Run  numbers 
corresponding  to  the  tests  of  Volume  I,  Appendix  A,  are  repeated  in  Table  2-1  for 
convenience.  A listing  of  variables  is  given  in  Appendix  A of  this  volume. 

XTR>  EXTRACT  RUN  LX1916  VAR  VNXSOP  or 
XTR>  EXTRACT  RUN  LX1916  ALL 

Up  to  100  variables  may  be  extracted  and  may  reside  in  the  scratch  file  at 
any  one  time.  Note  that  extracting  'ALL'  variables  places  92  variables  in  the 
scratch  file,  leaving  room  for  only  eight  more. 

2.2.3  DIRECTORY  Command 

This  command  causes  a listing  of  the  scratch  file  to  be  output  to  the  user's 
terminal.  This  listing  shows  which  records  are  contained  in  the  scratch  file.  The 
listing  for  each  record  includes  the  variable  numbers,  variable  name,  run  number, 
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TABLE  2-1.  LISTING  OF  TEST  RUN  NUMBERS 
RECOGNIZED  BY  THE  DRD  PROGRAM 


NBDL  Frontal  Test  Runs 


LX3524 

LX3525 

LX3530 

LX3531 

LX3536 

LX3537 

LX3544 

LX3548 

LX3550 

LX3558 

LX3573 

LX3578 

LX3583 

LX3616 

LX3779 

LX3780 

LX3782 

LX3783 

LX3785 

LX3786 

LX3788 

LX3789 

LX3791 

LX3793 

LX3794 

LX3796 

LX3797 

LX3798 

LX3800 

LX3801 

LX3803 

LX3804 

LX3805 

LX3807 

LX3808 

LX3809 

LX3812 

LX3814 

LX3815 

LX3817 

LX3818 

LX3819 

LX3821 

LX3822 

LX3823 

LX3824 

LX3833 

LX3837 

LX3839 

LX3840 

LX3841 

LX3842 

LX3851 

LX3852 

LX3854 

LX3856 

LX3857 

LX3858 

LX3869 

LX3870 

LX3871 

LX3872 

LX3875 

LX3876 

LX3878 

LX3880 

LX3882 

LX3883 

LX3885 

LX3886 

LX3887 

LX3889 

LX3890 

LX3893 

LX3894 

LX3895 

LX3898 

LX3900 

LX3901 

LX3903 

LX3904 

LX3906 

LX3908 

LX3909 

LX3913 

LX3914 

LX3916 

LX3918 

LX3920 

LX3921 

LX3924 

LX3926 

LX3927 

LX3928 

LX3939 

LX3940 

LX3941 

LX3942 

LX3944 

LX3945 

LX3946 

LX3948 

LX3949 

LX3950 

LX3951 

LX3953 

LX3954 

LX3955 

LX3957 

LX3958 

LX3959 

LX3961 

LX3962 

LX3963 

LX3965 

LX3968 

LX3969 

LX3970 

LX3972 

LX3982 

LX3983 

LX3985 

LX3986 

LX3987 

LX3989 

LX3990 

LX3991 

LX3993 

LX3994 

LX3995 

LX3997 

LX3998 

LX3999 

NBDL  Lateral  Test  Runs 

LX1454 

LX1456 

LX1457 

LX1458 

LX1468 

LX  1470 

LX1471 

LX1474 

LX1475 

LX1484 

LX1487 

LX1501 

LX1503 

LX1504 

LX1505 

LX  1507 

LX  1509 

LX1510 

LX1512 

LX1513 

LX1524 

LX1525 

LX1526 

LX1528 

LX1785 

LX1793 

LX1831 

LX1860 

LX1874 

LX1916 

LX1960 

LX1998 

LX2010 

LX2013 

LX2027 

LX2032 

LX2056 

LX2060 

LX2072 

LX2090 

LX2102 

LX2124 

LX2137 

LX2148 

LX2151 

LX2182 

LX2282 

LX2294 

LX2298 

LX2302 

LX2313 

LX2326 

LX2338 

LX2341 

LX2355 

LX4050 

LX4052 

LX4053 

LX4054 

LX4055 

LX4057 

LX4058 

LX4059 

XL4060 

LX4068 

LX4069 

LX4070 

LX4071 

LX4073 

LX4074 

LX4075 

LX4076 

LX4078 

LX4079 

LX4080 

LX4081 

LX4083 

LX4084 

LX4085 

LX4088 

LX4089 

LX4090 

LX4092 

LX4093 

LX4094 

LX4095 

LX4097 

LX4098 

. LX4099 

LX4100 

LX4104 

LX4107 

LX4109 

LX4110 

LX4111 

LX4112 

LX4114 

LX4115 

LX4116 

LX4118 

LX4119 

LX4120 

LX4123 

LX4124 

LX4125 

LX4126 

LX4128 

LX4129 

LX4130 

LX4131 

LX4133 

LX4134 

LX4135 

LX4137 

LX4138 

LX4139 

LX4140 

LX4142 

LX4143 

LX4144 

LX4145 

LX4147 

LX4148 

LX4149 

LX4151 

LX4153 

LX4155 
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NBDL  Oblique  Test  Runs 


LX2763 

LX2770 

LX2772 

LX2784 

LX2786 

LX2799 

LX2801 

LX2813 

LX2815 

LX2827 

LX2829 

LX2843 

LX2872 

LX2876 

LX2916 

LX2955 

• LX2973 

LX2979 

LX2982 

LX2985 

LX2988 

LX3049 

LX3053 

LX3061 

LX3065 

LX3077 

LX3085 

LX3089 

LX3093 

LX3097 

LX3100 

LX3102 

LX3106 

LX3122 

LX3129 

LX3133 

LX3145 

LX3148 

LX3153 

LX3158 

LX3417 

LX4159 

LX4161 

LX4162 

LX4163 

LX4164 

LX4166 

LX4167 

LX4168 

LX4170 

LX4171 

LX4172 

LX4234 

LX4235 

LX4236 

LX4237 

LX4238 

LX4240 

LX4241 

LX4242 

LX4243 

LX4244 

LX4246 

LX4247 

LX4248 

LX4249 

LX4251 

LX4259 

LX4260 

LX4261 

LX4263 

LX4264 

LX4265 

LX4266 

LX4268 

LX4269 

LX4270 

LX4271 

LX4276 

LX4277 

LX4280 

LX4281 

LX4282 

LX4284 

LX4286 

LX4287 

LX4288 

LX4290 

LX4291 

LX4292 

LX4293 

LX4295 

LX4296 

LX4297 

LX4298 

LX4301 

LX4302 

LX4303 

LX4305 

LX4306 

LX4307 

LX4309 

LX4310 

LX4313 

LX4314 

LX4316 

WSU  Frontal  Test  Runs 

DOT307 

DOT308 

DOT309 

DOT310 

DOT314 

DOT331 

DOT332 

DOT333 

DOT343 

DOT345 

DOT453 

DOT454 

DOT455 

UMTRI  Frontal  Test  Runs 
T76008 
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minimum  value,  maximum  value,  and  number  of  data  points  for  that  record.  This 
listing  contains  only  those  records  which  are  part  of  the  scratch  file  at  the  time 
the  DIRECTORY  command  is  given.  If  the  scratch  file  contains  no  records,  the 
message  "EMPTY"  is  sent  to  the  terminal  and  the  user  is  prompted  for  the  next 
command. 

2.2.4  FILE  Command 


This  command  is  used  to  place  the  contents  of  the  scratch  file  in  a 
permanent  disk  file  specified  by  the  given  filename.  The  file  is  written  in  scratch 
file  format,  making  it  possible  to  store  and  reuse  the  data  at  another  time. 

If  the  permanent  disk  file  does  not  exist,  it  is  created,  the  contents  of  the 
scratch  file  are  placed  in  it,  and  the  scratch  file  is  deleted. 

If  the  permanent  disk  file  does  exist,  the  contents  of  it  are  written  to  a file 
with  the  same  name  and  a version  number  one  higher  than  that  which  already 
exists.  The  filename  must  be  specified  in  single  quotes  using  VAX/VMS  filenaming 
convention. 


XTR>  FILE  'NEWDAT.DAT'  results  in  the  prompt; 

Variable  #'s  or  ALL  1,3,13,25  or 
Variable  //'s  or  ALL  ALL 

2.2.5  GET  Command 

The  GET  command  gets  files  that  were  filed  using  the  FILE  command. 
Filenames  must  include  the  user  default  directory  and  must  be  enclosed  in  single 
quotes.  The  file  specified  must  be  in  scratch  file  format  e.g,  if  the  NEWDAT.DAT 
file  in  the  above  example  is  created  in  directory  [CURTS.TEST]  the  GET  command 
looks  like: 


XTR>  GET  ' [CURTS.TEST]  NEWDAT.DAT' 
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2.2.6  END  Command 


The  END  command  ends  operation  of  the  program.  Control  is  returned  to 
DCL  (Digital  Command  Level)  of  the  VMS  operating  system. 

XTR  > END 

2.2.7  ADD  Command 


This  command  adds  the  values  of  the  fields  of  the  data  record  specified  by 
the  first  variable  name  to  those  of  the  second  variable  name  and  sets  the  results  in 
a new  record  which  is  given  the  name  specified  by  the  third  variable  name 
parameter.  This  name  must  be  enclosed  in  single  quotes.  The  data  records  used  to 
produce  the  new  variable  must  already  reside  in  the  scratch  file.  The  new  variable 
is  then  written  out  as  a new  record  on  the  scratch  file. 

XTR>  ADD  RUN  LX1960  VAR  AAXXOS  AAYXOS  'XPLUSY' 

/ 

2.2.8  SUBTRACT  Command 


This  is  the  same  as  the  ADD  command  except  that  the  values  of  the  record 
-selected  by  the  second  variable  name  are  instead  subtracted  from  the  record 
specified  by  the  first  variable  name. 

XTR  > SUBTRACT  RUN  LX1960  VAR  AAXXOS  AAYXOS  ’XMNUSY’ 

2.2.9  VMAGNITUDE  Command 


This  command  computes  the  vector  magnitude  of  a vector  specified  by  the 
first  three  variable  name  fields  following  the  VARIABLE  command.  These  fields 
specify  the  names  of  the  x,  y,  and  z components  of  a three  dimensional  vector. 
These  variables  must  already  be  contained  in  the  scratch  file.  They  are  used  to 
compute  the  vector  magnitude,  v,  according  to: 
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where  the  magnitude  "v"  is  specified  by  the  fourth  variable  name  parameter.  (Note 
that  this  parameter  is  a new  variable  name  which  is  not  one  of  the  names  on  the 
list  in  Table  2-1.  Also,  since  this  name  may  contain  from  one  to  six  characters,  it 
is  enclosed  by  single  quotes  in  order  to  aid  the  extraction  module  in  its  syntax 
analysis.)  A vector  magnitude  is  computed  and  stored  in  the  scratch  file. 

XTR>  V MAGNITUDE  RUN  LX1960  VAR  AAXXOS  AAYXOS  AAZXOS  'AAV MAG' 

2.2. 1 0 DIVIDE  Command 


This  command  divides  by  a constant  the  values  of  the  fields  of  the  data 
record  specified  by  the  first  variable  name  to  produce  a new  record  in  the  scratch 
file,  which  is  specified  by  the  second  variable  name.  The  new  name  must  be 
enclosed  in  single  quotes.  The  data  records  for  the  first  variable  must  already 
reside  in  the  scratch  file. 

XTR>  DIV  RUN  LX1960  VAR  AAXOS  -.396  'SCALED' 

2.2.11  CONSTANT  Command 

This  command  adds  a constant  to  the  values  of  the  fields  of  the  data 
record  specified  by  the  first  variable  name  to  produce  a new  record  in  the  scratch 
file,  which  is  specified  by  the  second  variable  name.  The  new  name  must  be 
enclosed  in  single  quotes.  The  data  records  for  the  first  variable  must  already 
reside  in  the  scratch  file. 

XTR>  CON  RUN  LX1960  VAR  AAXXOS  +.200  ^IAS' 

2.2.12  NORMALIZE  Command 


This  command  divides  the  values  of  each  field  of  the  data  record  specified 

by  the  first  variable  name  by  the  value  in  the  first  field  to  produce  a new  record  in 

the  scratch  field,  which  is  specified  by  a second  variable  name.  The  new  name 

must  be  enclosed  in  single  quotes.  The  data  records  for  the  first  variable  name 

% 

must  already  reside  in  the  scratch  file. 

XTR>  NOR  RUN  LX1960  VAR  AAXOS  'NORAAX' 
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2.2.13  STANDEV  Command 


The  STANDEV  command  calculates  mean,  mean  plus  standard  deviation, 
and  mean  minus  standard  deviation  and  standard  deviation  at  each  timestep  for  a 
given  variable.  The  scratch  file  is  searched  for  each  occurance  of  the  specified 
variable  and  each  occurance  is  used  in  the  calculation  of  mean  and  standard 
deviation  at  each  timestep.  The  three  new  variables  are  named  according  to  the 
following  convention; 

MOXXXX 

MPXXXX 

MMXXXX 

SDXXXX 

where  XXXX  stands  for  the  first  three  letters  of  the  given  variable  plus  either  a P 
or  an  S,  depending  on  whether  it  is  a photo  or  sensor  variable.  MO  stands  for  mean, 
MP  stands  for  mean  plus  standard  deviation,  MM  stands  for  mean  minus  standard 
deviation  and  SD  stands  for  standard  deviation 

XTR>  STANDEV  VAXXOS 

This  command  would  create  the  four  new  variables  MOVAXS,  MPVAXS,  MMVAXS 
and  SDVAXS. 

2.2.14  DSPLAY  Command 

The  DSPLAY  command  places  the  user  in  the  display  module  of  the  DRD 
program.  This  module  issues  a different  prompt,  'DSP  Once  in  this  module,  the 
user  chooses  from  the  following  commands; 

PLOT  DIRECTORY  DSPLAY 

XTRAC  END  COPY 
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A PLOT  command  is  entered  for  each  curve  to  be  plotted  on  a display  page. 
Multiple  plots  may  be  selected  for  the  same  display.  Up  to  20  PLOT  commands 
may  be  entered.  When  all  of  the  plots  have  been  requested  a DSPLAY  command  is 
entered  and  the  display  is  output  to  the  graphics  terminal.  Entering  a COPY 
command  rather  than  a DSPLAY  command  causes  output  to  be  displayed  on  the 
graphics  screen  and  then  generates  a copy  of  a hardcopy  unit. 

2.2. 14.1  PLOT  Command  - Each  plot  command  selects  two  variables  to  be  used 
as  the  x and  y values  of  a curve  to  be  plotted  two  dimensionally  on  a graphics 
device  such  as  a Tektronix  4010,  4114,  or  4115.  The  first  variable  name  is  used  as 
the  x coordinate,  the  second  variable  name  as  the  y coordinate.  All  variables 
selected  must  already  be  in  the  scratch  file  before  plot  commands  are  entered. 
Time  is  (of  course)  a valid  variable  name  for  both  photographic  and  sensor  data. 
When  plotting  sensor  variables,  time  is  calculated  when  necessary.  When  plotting 
photographic  variables,  the  time  variable  must  already  be  in  the  scratch  file. 

The  user  may  choose  from  several  line  formats.  Solid  lines,  solid  lines 
with  markers,  or  dashed  lines  are  the  available  options.  Marker  value  is  an  optional 
argument  for  this  command,  it  must  be  integer  and  may  be  between  -5  and  8. 
Markers  come  in  eight  flavors  (for  example:  squares,  circles,  or  triangles)  and  are 
denoted  by  the  integers  1 through  8.  Dashed  lines  come  in  five  types,  denoted  by 
the  integers  -5  through  -l.  If  no  marker  value  is  specified,  the  default  is  0,  the 
solid  line. 

\ 

The  user  may  also  optionally  specify  the  number  of  points  to  be  plotted. 
This  is  useful  when  plotting  photographic  data  vs.  sensor  data  when  the  number  of 
points  varies  or  when  the  user  is  interested  in  viewing  a smaller  segment  of  data. 
The  marker  argument  must  be  included  (it  may  be  a 0)  when  using  the  points 
feature.  Otherwise,  the  point  value  will  be  interpreted  as  a marker  value. 

DSP  > PLOT  RUN  LX1916  TIME  AAXXOS  will  give  a plot  of  time  vs. 

aaxxos  with  a solid  line 
(the  default). 

DSP  > PLOT  RUN  LX3958  TIME  ANXXOS  1 will  give  a plot  with  circles 

used  as  markers. 
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DSP  > PLOT  RUN  LX3958  TIME  VNXXOS  1 250  will  give  the  first  250  points  of 

this  plot  with  circles  as 
markers. 

DSP  > PLOT  RUN  LX3958  TIME  VNXSOP  -2  will  produce  the  plot  with  a 

dashed  line  (no  markers). 

2.2.14.2  DSPLAY  Command  - The  DSPLAY  command  is  used  to  mark  the  end  of 
the  plot  specifications  and  causes  generation  of  the  plot  on  the  current  graphics 
device.  All  plot  commands  issued  since  the  most  recent  other  DSPLAY  command 
will  be  plotted  on  a single  graph.  The  axes  will  be  scaled  to  accommodate  all 
variables  being  plotted.  They  will  be  labelled  with  the  dimensions  of  the  first  pair 
of  variables  to  be  plotted.  Figure  2-1  shows  the  multiple  plots  resulting  from  the 
sample  plot  commands  in  section  2.2.14.1. 

DSP  > DSPLAY 

2.2.14.3  COPY  Command  - The  COPY  command  also  marks  the  end  of  plot 
specifications  and  causes  generation  of  the  plot  on  the  graphics  screen. 
Additionally,  COPY  causes  a hard-copy  device  (a  Tektronix  printer)  to  copy  the 
screen  when  plotting  has  finished. 

DSP  > COPY 

2.2.14.4  DIRECTORY  Command  - The  DIRECTORY  command  is  the  same  as 
was  described  in  2.2.3. 

2.2.14.5  XTRAC  Command  - The  XTRAC  command  returns  the  user  to  the 
extraction  module  when  the  current  plotting  has  been  finished  so  that  additional 
data  files  may  be  processed. 

DSP  > XTRAC 

2.2.14.6  END  Command  - The  directory  command  is  the  same  as  was  described 
in  2.2.6. 
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Acceleration,  m/s 


30 . 0 


0 • 1 0 0.30 

Time,  secs. 


FIGURE  2-1.  EXAMPLE  OF  MULTICURVE  PLOTTING  CAPABILITY 
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3.  PROGRAM  FOR  CALCULATION  OF  HEAD  KINEMATIC  AND  LOAD 

RESPONSE  (HEAD) 

3.1  DESCRIPTION 

The  kinematic  and  load  response  of  the  head,  as  described  in  Volume  I by 
equations  (2),  (3),  (5),  (6),  (24),  (25)  and  (26)  are  calculated  by  the  HEAD  program. 
This  program  is  designed  for  use  in  conjunction  with  data  retrieved  by  the  DRD. 
Table  3-1  lists  the  NBDL  defined  variables  which  HEAD  reads  from  a DRD  scratch 
file.d) 


The  input  variables  are  a combination  of  photographic  and  accelerometer 
derived  variables  as  indicated  by  the  final  letter  of  the  Fortran  name-P  for  photo 
and  S for  accelerometer  (sensor).  Calculations  are  made  by  HEAD  at  the  times  at 
which  photo  data  is  digitized.  A subroutine  within  HEAD  interpolates  sensor  data, 
using  the  two  nearest  points  in  time  to  produce  acceleration  and  velocity  data  at 
the  photo  time  points. 

Subject  specific  data  as  indicated  in  Table  3-2  is  coded  into  HEAD  and  called 
as  required  to  match  the  test  subject  whose  data  has  been  read  from  the  scratch 
file. 


Table  3-3  lists  the  output  variables  which  are  calculated  and  attached  to  the 
DRD  scratch  file  which  ran  HEAD.  Note  six  variables  are  also  stored  in  a separate 
file  for  use  by  NECK,  indicating  that  the  latter  program  can  be  run  only  in 
conjunction  with  HEAD.  The  block  diagram  of  Figure  1-1  indicates  how  HEAD 
interfaces  with  the  DRD  package  and  with  NECK. 

3.2  USE  OF  THE  HEAD  PROGRAM 

The  variables  of  Table  3-1  must  be  present  in  the  scratch  file  of  the  DRD. 
When  a variable  name  appears  more  than  once  in  the  scratch  file,  the  first  is 
selected  for  use  by  HEAD. 


Neck  variables  ANXXOS  and  VNXXOS  are  included  as  input  to  HEAD  in  order  to 
enter  them  in  the  database  at  the  photo  timesteps.  They  are  not  required  for  head 
computations. 
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TABLE  3-1.  INPUT  VARIABLES  FOR  THE  HEAD  PROGRAM 


FORTRAN 

• 

ANALYSIS 

GENERAL  DEFINITION(1) 

SYMBOL 

SYMBOL 
(VOLUME  I) 

AAXXOS,  AAYXOS,  AAZXOS 

aAx,aAy»  aAz 

Linear  acceleration  of  the  head 
anatomical  origin 

ANXXOS 

— 

Linear  acceleration  of  the  Tl 
anatomical  origin 

PHAOXP,  PHB02P,  PHC03P 

eHx’  eHy’  0Hz 

Euler  angle  description  of  head 
rotation 

PNAOXP,  PNB02P,  PNC03P 

N 

z 

CD 

>% 

z 

CD 

X 

Z 

CD 

Euler  angle  description  of  Tl 
vertebral  rotation 

QHAOXS,  QHBOXS,  QHCOXS 

axVay>  a 2 

Angular  acceleration  of  the  head 

RHAOXS,  RHBOXS,  RHOCOXS 

“x*  “y*  “z 

Angular  velocity  of  the  head 

TIME 

— ■■■  ■ 

Time  at  which  photo  data  is 
digitized 

VNXXOS 

Linear  velocity  of  the  Tl 
anatomical  origin 

(1)  The  input  variables  are  fuliy  defined  in  Appendix  A. 
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TABLE  3-2.  SUBJECT  SPECIFIC  DATA  STORED  WITHIN  THE  HEAD  PROGRAM 


FORTRAN 

SYMBOL 

ANALYSIS 
SYMBOL 
(VOLUME  I) 

GENERALIZED  DESCRIPTION 

IX,  IY,  IZ 

I , I , I 
xx’  yy’  zz 

Centroidal  mass  moment  of  inertia 
coefficients  of  the  instrumented 
head  about  the  X,  Y,  and  Z axis, 
respectively,  of  the  head 
anatomical  coordinate  system 

MH 

Mh 

Mass  of  the  instrumented  head 

PXY,  PXZ 
PYX,  PYZ 
PZX,  PZY 

!xy’  *xz’  !Yz 

Centroidal  mass  product  of  inertia 
coefficients  of  the  instrumented 
head 

RGOX,  RGOY,  RGOZ 

rG/Ox’  rG/Oy,rG/Oz 

Position  of  the  head  center-of- 
gravity  relative  to  the  occipital 
condylar  point  (head  anatomical 
components). 
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TABLE  3-3.  OUTPUT  VARIABLES  FOR  THE  HEAD  PROGRAM 


FORTRAN 

SYMBOL 

ANALYSIS 
SYMBOL 
(VOLUME  I) 

GENERALIZED  DEFINITION^ 

AGXP,  AGYP,  AGZP 

aGx’  aGy’  aGz 

Linear  acceleration  of  the  head 
center-of-gravity 

ANXOP 

— 

Linear  acceleration  of  the  T1 
anatomical  origin 

FOXLP,  FOYLP,  FOZLP/ 
TOXLP,  TOZLP,  TOZLP 

r 19 

Laboratory  coordinate  system 
components  of  force/torque 
applied  to  the  head  by  the  neck  z 

FOXP,  FOYP,  FOZP 
TOXP,  TOYP,  TOZP 

F0x’  FOy»  FOz 
TOx’  TOy’  TOz 

Head  anatomical  coordinate 
system  components  of  force/torque 
applied  to  the  head  by  the  neck 

FOXTP,  FOYTP,  FOZTP 
TOXTP,  TOYTP,  TOZTP 

To  anatomical  coordinate  system 
components  of  force/torque 
applied  to  the  head  by  the  neck 

THTIXP,  THTYP 

>x 

-e- 

■e* 

Angular  orientation  of  the  head 
relative  to  the  torso. 

(1)  The  output  variables  are  fully  defined  in  Appendix  B. 

(2)  Variables  which  are  stored  for  use  by  program  NECK. 
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4.  PROGRAM  FOR  CALCULATION  OF  NECK  KINEMATIC  AND  LOAD 

RESPONSE  (NECK) 


4.1  DESCRIPTION 

The  kinematic  and  load  response  of  the  neck,  as  described  in  Volume  I by 
equations  (1),  (2),  (3),  (9),  (11),  (14),  (22)  and  (23)  are  calculated  by  the  NECK 
program.  The  program  is  designed  for  use  in  conjunction  with  the  DRD  and  HEAD 
programs  as  noted  in  the  previous  section.  Table  4-1  lists  the  NBDL  defined 
variables  which  NECK  reads  from  a DRD  scratch  file  and  from  HEAD**  All  input 
variables  are  photo-derived  so  there  is  no  need  for  interpolation  of  sensor  data  as 
in  HEAD. 

Subject  specific  data  as  indicated  in  Table  4-2  is  coded  into  NECK  and  is 
called  as  required  to  match  the  test  subject  whose  data  has  been  read  from  the 
scratch  file.  Parameters  ARP,  BR  and  DNZMN  are  used  to  correct  the  data  for 
observed  error  in  the  vertical  mounted  position  of  the  T1  instrumentation  as 
described  in  Section  5.1.  This  data  correction  is  made  in  NECK  thereby  preserving 
the  original  database  for  use  by  other  researchers.  Provision  has  not  been  made  for 
display  of  the  corrected  variable,  DNZSOP,  since  it  was  not  required  for 
presentation  of  study  results. 

Table  4-3  lists  the  variables  which  are  calculated  and  attached  to  the  DRD 
scratch  file  which  was  used  to  run  NECK.  Figure  1-1  is  a block  diagram  which 
indicates  how  NECK  interfaces  with  DRD  and  HEAD. 

4.2.  USE  OF  THE  NECK  PROGRAM 

The  variable  of  Table  4-1  must  be  present  in  the  scratch  file  of  the  DRD. 
When  a variable  name  appears  more  than  once  in  the  scratch  file,  the  first  is 
selected  for  use  by  NECK. 

Reduced  versions  of  HEAD  and  NECK,  that  require  only  photo-derived  variables 
were  used  to  process  data  from  Wayne  State  University  and  the  University  of 
Michigan.  In  the  reduced  programs,  there  is  no  input  to  NECK  required  from  HEAD* 
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TABLE  4-1.  INPUT  VARIABLES  FOR  THE  NECK  PROGRAM 


FORTRAN 

SYMBOL 

ANALYSIS 
SYMBOL 
(VOLUME  I) 

GENERALIZED  DEFINITION(1) 

FROM  DRD  SCRATCH  FILE: 

DAXSOP,  DAYSOP,  DAZSOP 

rA 

Displacement  of  the  head  relative 
to  the  sled 

DNXSOP,  DNYSOP,  DNZSOP 

rT 

Displacement  of  the  T1  vertebral 
body  relative  to  the  sled 

PHAOXP,  PHB02P,  PHC03P 

eHx»  0Hy»  eHz 

Euler  angle  description  of  head 
rotation 

PNAOXP,  PNB02P,  PNC03P 

CD 

z 

X 

CD 

z 

*< 

CD 

Z 

N 

Euler  angle  description  of  T1 
vertebral  rotation 

TIME 

— 

Time  at  which  photo  data  is 
digitized 

FROM  HEAD  PROGRAM: 

FOXLP,  FOYLP,  FOZLP  

TOXLP,  TOYLP,  TOZLP 

applied  to  the  head  by  the  neck. 

Laboratory  coordinate  system 
components  of  force/torque 

(1)  The  input  variables  are  fully  defined  in  Appendix  A. 
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TABLE  4-2.  SUBJECT  SPECIFIC  DATA  STORED  WITHIN  THE  NECK  PROGRAM 


FORTRAN 

•SYMBOL 

ANALYSIS 
SYMBOL 
(VOLUME  I) 

GENERALIZED  DEFINITION 

ARP,  BR,  DNZMN 

a*,  Ml  , 
(°R)2 

(DNZSOP)M 

a,  b, 

Least  squares  fit  parameters 
for  correcting  Tl  vertical 
position  DNZSOP 

RGAX,  RGAZ 

rG/Ax’  rG/Az 

Position  of  the  head  center-of- 
gravity  relative  to  the  head 
anatomical  origin  (head  anatomical 
components  • 

*a  = (DNZSOP)m  + Jill — (RATIP)m 

(cr)2 
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TABLE  4-3.  OUTPUT  VARIABLES  FOR  THE  NECK  PROGRAM 


FORTRAN 

SYMBOL 

ANALYSIS 
SYMBOL 
(VOLUME  I) 

GENERALIZED  DEFINITIONS(1) 

PSI 

Externally  observed  head  twist 
relative  to  the  torso 

RATIP 

rO/T'rO/A 

Distance  from  the  T1  vertebral  to 
the  head  anatomical  origin 

ROTIP 

rO/T~rO/C 

Distance  from  the  T1  vertebral  to 
the  occipital  condylar  point  ("Neck 
chord  length") 

TENTXP, 

TENTYP 

CD 

X 

CD 

*< 

Angular  orientation  of  the  neck 
chord  vector  relative  to  the  torso 

TETHNP 

+ 1 

Internally  measured  head  twist 
about  the  head  z-axis 

T1XLP,  T1YLP, 

/ 

TIZLPcomponents  of  the  torque 

• Laboratory  coordinate  system 
applied  to  the  neck  by  the  torso 

T1XTP,  T1YTP 
T1ZTP 

To  coordinate  system  components 
of  the  torque  applied  to  the  neck 

by  the  torso 


(1)  The  output  variables  are  fully  defined  in  Appendix  B. 
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APPENDIX  A 


DEFINITION  OF  VARIABLES  CONTAINED  IN  THE  NBDL  DATBASE 


(REPRODUCED  FROM  REF.  4) 


A-I/A-2 


AAXXOS 

AAAYXOS 

AAZXOS 

QHAOXS 

QHBOXS 

QHCOXS 

VAXXOS 

VAXSOS 

VAYXOS 

VAYSOS 

VAZXOS 


The  component  of  linear  acceleration  of  the  head  anatomical  drigin 
along  the  X axis  of  the  laboratory  coordinate  system  with  respect  to 
the  fixed  laboratory  coordinate  system  as  derived  from  mouth 
mount  accelerometer  data. 

The  component  of  linear  acceleration  of  the  head  anatomical  origin 
along  the  Y axis  of  the  laboratory  coordinate  system  with  respect  to 
the  fixed  laboratory  coordinate  system  as  derived  from  mouth 
mount  accelerometer  data. 

The  component  of  linear  acceleration  of  the  head  anatomical  origin 
along  the  Z axis  of  the  laboratory  coordinate  system  with  respect  to 
the  fixed  laboratory  coordinate  system  as  derived  from  mouth 
mount  accelerometer  data. 

Angular  acceleration  of  the  head  about  the  X axis  of  head 
anatomical  coordinate  system  as  derived  from  mouth  mount 
accelerometer  data. 

Angular  acceleration  of  the  head  about  the  Y axis  of  the  head 
anatomical  coordinate  system  as  derived  from  mouth  mount 
accelerometer  data. 

Angular  acceleration  of  the  head  about  the  Z axis  of  the  head 
anatomical  coordinate,  system  as  derived  from  mouth  mount 
accelerometer  data. 

The  component  of  linear  velocity  of  the  head  anatomical  origin 
along  the  X axis  of  the  laboratory  coordinate  system  with  respect  to 
the  fixed  laboratory  coordinate  system  as  derived  from  mouth 
mount  accelerometer  data. 

The  component  of  linear  velocity  of  the  head  anatomical  origin 
along  the  X axis  of  the  sled  coordinate  system  with  respect  to  the 
sled  coordinate  system  as  derived  from  accelerometer  data.  The 

sled  coordinate  system  is  aligned  with  the  laboratory  coordinate 

system  and  translates  with  the  sled. 

The  component  of  linear  velocity  of  the  head  anatomical  origin 
along  the  Y axis  of  the  laboratory  coordinate  system  with  respect  to 
the  fixed  laboratory  coordinate  system  as  derived  from  mouth 
mount  accelerometer  data. 

The  component  of  linear  velocity  of  the  head  anatomical  origin 
along  the  Y axis  of  the  sled  coordinate  system  with  respect  to  the 
sled  coordinate  system  as  derived  from  accelerometer  data.  The 

sled  coordinate  system  is  aligned  with  the  laboratory  coordinate 

system  and  translates  with  the  sled. 

The  component  of  linear  velocity  of  the  head  anatomical  origin 
along  the  Z axis  of  the  laboratory  coordinate  system  with  respect  to 
fixed  laboratory  coordinate  system  as  derived  from  mouth  mount 
accelerometer  data. 
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VAZSOS 


RHAOXS 


RHBOXS 


RHCOXS 


DAXXOS 


DAXSOS 


DAYXOS 


DAYSOS 


DAZXOS 


DAZSOS 


The  component  of  linear  velocity  of  the  head  anatomical  origin 
along  the  Z axis  of  the  sled  coordinate  system  with  respect  to  the 
sled  coordinate  system  as  derived  from  accelerometer  data.  The 
sled  coordinate  system  is  aligned  with  the  laboratory  coordinate 
system  and  translates  with  the  sled. 

Angular  velocity  of  the  head  about  the  X axis  of  the  head 
anatomical  coordinate  system  as  derived  from  mouth  mount 
accelerometer  data. 

Angular  velocity  of  the  head  about  the  Y axis  of  the  head 
anatomical  coordinate  system  as  derived  from  mouth  mount 
accelerometer  data. 

Angular  velocity  of  the  head  about  the  Z axis  of  the  anatomical 
coordinate  system  as  derived  from  mouth  mount  accelerometer 
data. 

The  component  of  linear  displacement  of  the  head  anatomical  origin 
along  the  X axis  of  the  laboratory  coordinate  system  with  respect  to 
the  fixed  laboratory  coordinate  system  as  derived  from  mouth 
mount  accelerometer  data. 

The  component  of  linear  displacement  of  the  head  anatomical  origin 
along  the  X axis  of  the  sled  coordinate  system  with  respect  to  the 
sled  coordinate  system  as  derived  from  accelerometer  data.  The 
sled  coordinate  system  is  aligned  with  the  laboratory  coordinate 
system  and  translates  with  the  sled. 

The  component  of  linear  displacement  of  the  head  anatomical  origin 
along  the  Y axis  of  the  laboratory  coordinate  system  with  respect  to 
the  fixed  laboratory  coordinate  system  as  derived  from  mouth 
mount  accelerometer  data. 

The  component  of  linear  displacement  of  the  head  anatomical  origin 
along  the  Y axis  of  the  sled  coordinate  system  with  respect  to  the 
sled  coordinate  system  as  derived  from  accelerometer  data.  The 

sled  coordinate  system  is  aligned  with  the  laboratory  coordinate 

system  and  translates  with  the  sled. 

The  component  of  linear  displacement  of  the  head  anatomical  origin 
along  the  Z axis  of  the  laboratory  coordinate  system  with  respect  to 
the  fixed  laboratory  coordinate  system  as  derived  from  mouth 
mount  accelerometer  data. 

The  component  of  linear  displacement  of  the  head  anatomical  origin 
along  the  Z axis  of  the  sled  coordinate  system  with  respect  to  the 
sled  coordinate  system  as  derived  from  accelerometer  data.  The 

sled  coordinate  system  is  aligned  with  the  laboratory  coordinate 

system  and  translates  with  the  sled. 


PHAOXS 


PHB02S 


PHC03S 


4H001S 

4H002S 

4H003S 

4H004S 

ANXXOS 


ANYXOS 


ANZXOS 


QNAOXS 

QNBOXS 

QNCOXS 

VNXXOS 

VNXSOS 


Angle  of  rotation  of  the  head  about 
the  X axis  of  the  head  anatomical 
coordinate  system  as  derived  from 
mouth  mount  acceleromter  data.  Head 
anatomical  coordinate  system  is 
initially  aligned  with  the  laboratory 
coordinate  system. 


Same  as  PHAOXS  except  about  the  carried 
Y axis. 


Same  as  PHAOXS  except  about  the  carried 
Z axis. 


EULER 

ANGLES 


Quaternions  - The  four  variables  which  define  the  angular 
orientation  of  the  head  anatomical  coordinate  system  relative  to  the 
laboratory  coordinate  system  as  derived  from  mouth  mount 
accelerometer. 


The  component  of  linear  acceleration  of  Tj  anatomical  origin  along 
the  X axis  of  the  laboratory  coordinate  system  with  respect  to  the 
fixed  laboratory 

The  component  of  linear  acceleration  of  the  T.  anatomical  origin 
along  the  Y axis  of  the  laboratory  coordinate  system  with  respect  to 
the  fixed  laboratory  coordinate  system  as  derived  from  T^  mount 
accelerometer  data. 

The  component  of  linear  acceleration  of  the  T.  anatomical  origin 
along  the  Z axis  of  the  laboratory  coordinate  system  with  respect  to 
the  fixed  laboratory  coordinate  system  as  derived  from  Tj  mount 
accelerometer  data. 

Angular  acceleration  of  Tj  (first  Thoracic  vertebral  body)  about  the 

Y axis  of  the  T^  anatomical  coordinate  system  as  derived  from  T^ 
mount  accelerometer  data. 

Angular  acceleration  of  T^  (first  Thoracic  vertebral  body)  about  the 

Y axis  of  the  T^  anatomical  coordinate  system  as  derived  from  T^ 
mount  accelerometer  data. 

Angular  acceleration  of  T^  (first  Thoracic  vertebral  body)  about  the 
Z axis  of  the  T^  anatomical  coordinate  system  as  derived  from  T^ 
mount  accelerometer  data. 


The  component  of  linear  velocity  of  the  Tj  anatomical  origin  along 
the  X axis  of  the  laboratory  coordinate  system  with  respect  to  the 
fixed  laboratory  coordinate  system  as  derived  from  T^  mount 
accelerometer  data. 

The  component  of  linear  velocity  of  the  T^  anatomical  origin  along 
the  X axis  of  the  sled  coordinate  system  with  respect  to  sled 
coordinate  system  as  derived  from  accelerometer  data.  The  sled 
coordinate  system  is  aligned  with  the  laboratory  coordinate  system 
and  translates  with  the  sled. 
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VNYXOS 


VNYSOS 


VNZXOS 


VNZSOS 


RNAOXS 


RNBOXS 


RNCOXS 

DNXXOS 


DNXSOS 


DNYXOS 


The  component  of  linear  velocity  of  the  anatomical  origin  along 
the  Y axis  of  the  laboratory  coordinate  system  with  respect  to  the 
fixed  laboratory  coordinate  system  as  derived  from  Tj  mount 

accelerometer  data. 

The  component  linear  velocity  of  the  T^  anatomical  origin  along  the 
Y axis  of  sled  coordinate  system  with  respect  to  sled  coordinate 
system  as  derived  from  accelerometer  data.  The  sled  coordinate 
system  is  aligned  with  the  laboratory  coordinate  system  and 

translates  with  the  sled. 

The  component  of  linear  velocity  of  the  Tj  anatomical  origin  along 
the  X axis  of  the  laboratory  coordinate  system  with  respect  to  the 
fixed  laboratory  coordinate  system  as  derived  from  T^  mount 

accelerometer  data. 

The  component  of  linear  velocity  of  the  Tj  anatomical  origin  along 
the  Z axis  of  sled  coordinate  system  with  respect  to  sled  coordinate 
system  as  derived  from  accelerometer  data.  The  sled  coordinate 
system  is  aligned  with  the  laboratory  coordinate  system  and 

translates  with  the  sled. 

Angular  velocity  of  T (first  Thoracic  vertebral  body)  about  the  X 
axis  of  the  T.  anatomical  coordinate  system  as  derived  from  T 
mount  accelerometer  data. 

Angular  velocity  of  T.  (first  Thoracic  vertebral  body)  about  the  Y 
axis  of  the  T.  anatomical  coordinate  system  as  derived  from  T. 
mount  accelerometer  data. 

Angular  velocity  of  T^  (first  Thoracic  vertebral  body)  about  the  Z 
axis  of  the  T^  anatomical  coordinate  system  as  derived  from  T^ 
mount  accelerometer  data. 

The  component  of  linear  displacement  of  the  T^  anatomical  origin 
along  the  X axis  of  the  laboratory  coordinate  system  with  respect  to 
the  fixed  laboratory  coordinate  system  as  derived  from  T mount 
accelerometer  data. 

The  component  of  linear  displacement  of  the  T.  anatomical  origin 
along  the  X axis  of  the  sled  coordinate  system  with  respect  to  the 
sled  coordinate  system  as  derived  from  accelerometer  data.  The 
sled  coordinate  system  is  aligned  with  the  laboratory  coordinate 
system  and  translates  with  the  sled. 

The  component  of  linear  displacement  of  the  T.  anatomical  origin 
along  the  Y axis  of  the  laboratory  coordinate  system  with  respect  to 
the  fixed  laboratory  coordinate  system  as  derived  from  T mount 
accelerometer  data.  1 


DNYSOS 


DNZXOS 


DNZSOS 


PNAOXS 


PNB02S 

PNC03S 

4NOQ1S 


ACXXOS 

VCXXOS 

DCXXOS 

VAXSOP 


The  component  of  linear  displacement  of  the  anatomical  origin 
along  the  Y axis  of  the  sled  coordinate  system  with  respect  to  the 
sled  coordinate  system  as  derived  from  accelerometer  data.  The 
sled  coordinate  system  is  aligned  with  the  laboratory  coordinate 
system  and  translates  with  the  sled. 

The  component  of  linear  displacement  of  the  T.  anatomical  origin 
along  the  Z axis  of  the  laboratory  coordinate  system  with  respect  to 
the  fixed  laboratory  coordinate  system  as  derived  from  T^  mount 
accelerometer  data. 


The  component  of  linear  displacement  of  the  T.  anatomical  origin 
along  the  Z axis  of  the  sled  coordinate  system  with  respect  to  the 
sled  coordinate  system  as  derived  from  accelerometer  data.  The 
sled  coordinate  system  is  aligned  with  the  laboratory  coordinate 
system  and  translates  with  the  sled. 


Angle  of  rotation  of  T.  (first  Thoracic  vertebral 
body)  about  the  X axisof  the  T . anatomical 
coordinate  system  as  derived  from  T,  mount 
accelerometer  data.  The  T . anatomrcal 
coordinate  system  is  initially  aligned  with 
the  laboratory  coordinate  system. 


V EULER 
ANGLES 


Same  as  PNAOXS  except  about  the  carried  Y axis. 


Same  as  PNB02S  except  about  the  carried  Z axis. 


Quaternions  - the  four  variables  which  define  the  angular  4N002S 
orientation  of  the  T.  anatomical  coordinate  system  4N003S 
relative  to  the  laboratory  coordinate  system  as  4NOO^S  derived 
from  Tj  mount  accelerometer  data. 


Linear  acceleration  of  the  sled  along  the  X axis  of  the  laboratory 
coordinate  system  with  respect  to  the  fixed  laboratory  coordinate 
system  as  measured  by  sled  mounted  accelerometer. 


Linear  velocity  of  the  sled  along  the  X axis  of  the  laboratory 
coordinate  system  with  respect  to  the  fixed  laboratory  coordinate 
system  as  derived  from  sled  mounted  accelerometer  data. 


Linear  displacement  of  the  sled  along  the  X axis  of  the  laboratory 
coordinate  system  with  respect  to  the  fixed  laboratory  coordinate 
system  as  derived  from  sled  mounted  accelerometer  data. 

The  component  of  linear  velocity  of  the  head  anatomical  origin 
along  the  X axis  of  the  sled  coordinate  system  with  respect  to  the 
sled  coordinate  system  as  derived  from  mouth  mount  photo  target 
data.  The  sled  coordinate  system  is  aligned  with  the  laboratory 
coordinate  system  and  translates  with  the  sled. 


A -7 


VAYSOP 

VAXSOP 

RHAOXP 

RHBOXP 

RHCOXP 

DAXSOP 

DAYSOP 

DAZSOP 

PHAOXP 

PHB02P 

PHC03P 


The  component  of  linear  velocity  of  the  head  anatomical  origin 
along  the  Y axis  of  the  sled  coordinate  system  with  respect  to  the 
sled  coordinate  system  as  derived  from  mouth  mount  photo  target 
data.  The  sled  coordinate  system  is  aligned  with  the  laboratory 
coordinate  system  and  translates  with  the  sled. 

The  component  of  linear  velocity  of  the  head  anatomical  origin 
along  the  Z axis  of  the  sled  coordinate  system  with  respect  to  the 
sled  coordinate  system  as  derived  from  mouth  mount  photo  target 
data.  The  sled  coordinate  system  is  aligned  with  the  laboratory 
coordinate  system  and  translates  with  the  sled. 

Angular  velocity  of  the  head  about  the  X axis  of  the  head 
anatomical  coordinate  system  as  derived  from  mouth  mount  photo 
target  data. 

Angular  velocity  of  the  head  about  the  Y axis  of  the  head 
anatomical  coordinate  system  as  derived  from  mouth  mount  photo 
target  data. 

Angular  velocity  of  the  head  about  the  Z axis  of  the  head 
anatomical  coordinate  system  as  derived  from  mouth  mount  photo 
target  data. 

The  component  of  linear  displacement  of  the  head  anatomical  origin 
along  the  X axis  of  the  sled  coordinate  system  with  respect  to  the 
sled  coordinate  system  as  derived  from  mouth  mount  photo  target 
data.  The  sled  coordinate  system  is  aligned  with  the  laboratory 
coordinate  system  and  translates  with  the  sled. 

The  component  of  linear  displacement  of  the  head  anatomical  origin 
along  the  Y axis  of  the  sled  coordinate  system  with  respect  to  the 
sled  coordinate  system  as  derived  from  mouth  mount  photo  target 
data.  The  sled  coordinate  system  is  aligned  with  the  laboratory 
coordinate  system  and  translates  with  the  sled. 


The  component  of  linear  displacement  of  the  head  anatomical  origin 
along  the  Z axis  of  the  sled  coordinate  system  with  respect  to  the 
sled  coordinate  system  as  derived  from  mouth  mount  photo  target 
data.  The  sled  coordinate  system  is  aligned  with  the  laboratory 
coordinate  system  and  translates  with  the  sled 

Angle  of  rotation  of  the  head  about  the  X axis 
of  the  head  anatomical  coordinate  system 
as  derived  from  mouth  mount  photo  target 
data.  Head  anatomical  coordinate  system 
is  initially  aligned  with  the  laboratory 
coordinate  system 

Same  as  PHAOXP  except  about  the  carried  Y axis.. 


!. 


V EULER 
' ANGLES 


Same  as  PHB02P  except  about  the  carried  Z axis. 


4H001P 

4H002P 

4H003P 

4H004P 


Quaternions  - The  four  variables  which  define 
the  angular  orientation  of  the  head  anatomical 
coordinate  system  relative  to  the  laboratory 
system  as  derived  from  mouth  mount  photo  target 
data. 


VNXSOP 


VNYSOP 


VNZSOP 


RNAOXP 


RNBOXP 


RNCOXP 


DNXSOP 


DNYSOP 


DNZSOP 


The  component  of  linear  velocity  of  the  T anatomical  origin  along 
the  X axis  of  the  sled  coordinate  system1  with  respect  to  the  sled 
coordinate  system  as  derived  from  T mount  photo  target  data.  The 
sled  coordinate  system  is  aligned  with  the  laboratory  coordinate 
system  and  translates  with  the  sled. 

The  component  of  linear  velocity  of  the  T^  anatomical  origin  along 
the  Y axis  of  the  sled  coordinate  system  with  respect  to  the  sled 
coordinate  system  as  derived  from  T mount  photo  target  data.  The 
sled  coordinate  system  is  aligned  with  the  laboratory  coordinate 
system  and  translates  with  the  sled. 

The  component  of  linear  velocity  of  the  T^  anatomical  origin  along 
the  Z axis  of  the  sled  coordinate  system  with  respect  to  the  sled 
coordinate  system  as  derived  from  T^  mount  photo  target  data.  The 
sled  coordinate  system  is  aligned  with  the  laboratory  coordinate 
system  and  translates  with  the  sled. 

Angular  velocity  of  T (first  Thoracic  vertebral  body)  about  the  X 
axis  of  the  T.  anatomical  coordinate  system  as  derived  from  T, 
mount  photo  target  data. 

Angular  velocity  of  T^  (first  Thoracic  vertebral  body)  about  the  Y 
axis  of  the  T^  anatomical  coordinate  system  as  derived  from  T^ 
mount  photo  target  data. 

Angular  velocity  of  T^  (first  Thoracic  vertebral  body)  about  the  Z 
axis  of  the  T^  anatomical  coordinate  system  as  derived  from  T^ 
mount  photo  target  data. 

The  component  of  linear  displacement  of  the  T anatomical  origin 
along  the  X axis  of  the  sled  coordinate  system  with  respect  to  the 
sled  coordinate  system  as  derived  from  T.  mount  photo  target  data. 
The  sled  coordinate  system  is  aligned  with  laboratory  coordinate 
system  and  translates  with  the  sled. 

The  component  of  linear  displacement  of  the  T anatomical  origin 
along  the  Y axis  of  the  sled  coordinate  system  with  respect  to  the 
sled  coordinate  system  as  derived  from  T.  mount  photo  target  data. 
The  sled  coordinate  system  is  aligned  with  laboratory  coordinate 
system  and  translates  with  the  sled. 

The  component  of  linear  displacement  of  the  T^  anatomical  origin 
along  the  Z axis  of  the  sled  coordinate  system  with  respect  to  the 
sled  coordinate  system  as  derived  from  Tj  mount  photo  target  data. 
The  sled  coordinate  system  is  aligned  with  laboratory  coordinate 
system  and  translates  with  the  sled. 


A -9 


PNAOXP  Angle  of  rotation  of 

(first  Thoracic  vertebral  body) 
about  the  X axis  of  the 
anatomical  coordinate  system  as 
derived  from  mount  photo 
target  data.  The  T^  anatomical 
coordinate  system  is  initially  aligned 
with  the  laboratory  coordinate  system. 

PNB02P  Same  as  PNAOXP  except  about  the  carried 
Y axis. 


PNC03P  Same  as  PNB02P  except  about  the  carried 
Z axis. 

4N001P  Quaternions  - The  four  variables  which 

4N002P  define  the  angular  orientation  of  the 

4N003P  Tj  anatomical  coordinate  system 

4NOO4P  relative  to  the  laboratory  coordinate 

system  as  derived  from  T mount  photo 
target  data. 

TIME  Time  at  which  exposure  occurred  for  film 

frames  that  were  digitized  to  produce 
photo  variables. 

The  unit  of  all  variables  are  consistent  with 


Linear  measure  - meters 
Angular  measure  - radians 
Time  measure  - seconds 


) 


EULER 

ANGLES 
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APPENDIX  B 

DEFINITION  OF  CALCULATED  VARIABLES  BY  THE  HEAD  AND  NECK  PROGRAMS 


B-l/B-2 


FORTRAN 

SYMBOL 

AGXP 

AGYP 

AGZP 

FOXLP 

FOYLP 

FOZLP 

FOXP 

FOYP 

FOZP 

FOXTP 

FOYTP 

FOZTP 

PSl‘ 


DEFINITION 


The  linear  accleration  of  the  head  center  of  gravity  along  the  x-axis 
of  the  head  anatomical  coordinate  system  with  respect  to  the  fixed 
laboratory  coordinate  system. 

The  linear  accleration  of  the  head  center  of  gravity  along  the  y-axis 
of  the  head  anatomical  coordinate  system  with  respect  to  the  fixed 
laboratory  coordinate  system. 

The  linear  accleration  of  the  head  center  of  gravity  along  the  z-axis 
of  the  head  anatomical  coordinate  system  with  respect  to  the  fixed 
laboratory  coordinate  system. 


The  force  applied  by  the  neck  to  the  head  parallel  to  the  laboratory 
x-axis  and  passing  through  the  occipital  condylar  point. 

The  force  applied  by  the  neck  to  the  head  parallel  to  the  laboratory 
y-axis  and  passing  through  the  occipital  condylar  point. 

The  force  applied  by  the  neck  to  the  head  parallel  to  the  laboratory 
z-axis  and  passing  through  the  occipital  condylar  point. 

The  force  applied  by  the  neck  to  the  head  at  the  occipital  condylar 
point  parallel  to  the  x-axis  of  the  head  anatomical  coordinate 
system. 

The  force  applied  by  the  neck  to  the  head  at  the  occipital  condylar 
point  parallel  to  the  y-axis  of  the  head  anatomical  coordinate 
system. 

The  force  applied  by  the  neck  to  the  head  at  the  occipital  condylar 
point  parallel  to  the  z-axis  of  the  head  anatomical  coordinate 
system. 

The  force  applied  by  the  neck  to  the  head  parallel  to  the  x-axis  of 
the  T coordinate  system  and  passing  through  the  occipital  condylar 
point. 

The  force  applied  by  the  neck  to  the  head  along  the  y-axis  of  the  T 
coordinate  system  and  passing  through  the  occipital  condylar  point.  ° 

The  force  applied  by  the  neck  to  the  head  along  the  z-axis  of  the  T 
coordinate  system  and  passing  through  the  occipital  condylar  point.  ° 

The  angle  between  the  y-axis  of  the  T coordinate  system  and  the 
projection  of  the  y-axis  of  the  head  anatomical  coordinate  system 
onto  the  x-y  plane  of  the  Tq  coordinate  system. 
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FORTRAN  . 
SYMBOL 

RATIP 

ROTIP 

TENTYP 

TENTXP 

TETHNP 

THTIYP 

THTIXP 

TOXLP 

TOYLP 

TOZLP 

TOXP 

TOYP 

TOZP 

TOXTP 

TOYTP 

TOZTP 

T1XTP 


DEFINITION 


The  distance  from  the  head  anatomical  origin  to  the  T anatomical 
origin  as  derived  from  photographic  data. 

The  distance  from  the  occipital  condylar  to  the  T anatomical  origin. 

The  angle  between  the  z-axis  of  the  Tq  coordinate  system  and  the 
projection  of  the  neck  chord  vector  onto  the  x-z  plane  of  the  Tq 
coordinate  system. 

The  angle  between  the  neck  chord  vector  and  the  x-z  plane  of  the 

T coordinate  system, 
o 

The  angle  between  the  y-axis  of  the  head  anatomical  coordinate 
system  and  the  projection  of  the  y-axis  of  the  Tq  coordinate  system 
onto  the  y-y  plane  of  the  head  anatomical  coordinate  systems. 

The  angle  between  the  z-axis  of  the  T coordinate  system  and  the 
projection  of  the  z-axis  of  the  head  anatomical  coordinate  system 
onto  the  x-z  plane  of  the  Tq  coordinate  system. 

The  angle  between  the  z-axis  of  the  head  anatomical  coordinate 
system  and  the  x-z  plane  of  the  Tq  coordinate  system. 

The  moment  applied  by  the  neck  to  the  head  about  an  axis  parallel 
to  the  laboratory  x-axis. 

The  moment  applied  by  the  neck  to  the  head  about  an  axis  parallel 
to  the  laboratory  y-axis. 

The  moment  applied  by  the  neck  to  the  head  about  an  axis  parallel 
to  the  laboratory  z-axis. 

The  moment  applied  by  the  neck  to  the  head  axis  that  is  parallel  to 
the  x-axis  of  the  head  anatomical  coordinate  system. 

The  moment  applied  by  the  neck  to  the  head  axis  that  is  parallel  to 
the  y-axis  of  the  head  anatomical  coordinate  system. 

The  moment  applied  by  the  neck  to  the  head  axis  that  is  parallel  to 
the  z-axis  of  the  head  anatomical  coordinate  system. 

The  moment  applied  by  the  neck  to  the  head  about  an  axis  parallel 
to  the  z-axis  of  the  Tq  coordinate  system. 

The  moment  applied  by  the  neck  to  the  head  about  an  axis  parallel 
to  the  y-axis  of  the  Tq  coordinate  system. 

The  moment  applied  by  the  neck  to  the  head  about  an  axis  parallel 
to  the  z-axis  of  the  Tq  coordinate  system. 

The  moment  applied  by  the  torso  to  the  neck  about  an  axis  parallel 
to  the  x-axis  of  the  Tq  coordinate  system. 


FORTRAN 

SYMBOL 

TlYTP 

TlZTP 


DEFINITION 


The  moment  applied  by  the  torso  to  the  neck  about  an  axis  parallel 
to  the  y-axis  of  the  Tq  coordinate  system. 

The  moment  applied  by  the  torso  to  the  neck  about  an  axis  parallel 
to  the  z-axis  of  the  Tq  coordinate  system. 
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APPENDIX  C 


FORTRAN  CODING  OF  THE  DATA  RETRIEVAL  ANALYSIS  AND  DISPLAY  SOFTWARE 


C-l/C-2 


.1 


The  programs  contained  in  this  appendix  are  listed  below.  The  general 
purpose  programs  listed  are  available  on  the  NHTSA  VAX  in  two  locations; 
TSCPROGLIB  and  ASGPROGLIB. 


COM  P 

SMEAN 

XTRAC 

MATH 

XTRBLK 

MNMX 

ACCDIS 

CURD 

DSPLAY 

LABLE 

EXTRCT 

SYMBOL 

DCIFER 

TITLE 

DIRECT 

DSP-WPAGE 

STANDEV 

DSP-OVERLAY 

STDCAL 

NCKNEW  (NECK) 

TRQPHOR  (HEAD) 

C-3/C -k 


SUBROUTINE  COMP 
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ooo  i 

0002 

0003 

0004 

0005 

0006 

0007 

0008 

0009 

0010 


«• 


* j SUBROUTINE  COMP 

* INCLUDE  module  for  NCKPHO.  FOR  Sc  TRQPHO.  FOR 

* 

REAL  DAXSOP ( 600 ) , DAYSOP ( 600 ) , DAZSOP ( 600 ) , DNXSOP  < 600  > , 

DNYSOP ( 600  > , DNZSOP  < 600 ) , PHAOXP ( 600 ) , PHB02P ( 600 ) , PHC03P ( 600 ) , 
PNAOXP (600) i PNB02P ( 600 ) » PNC03P ( 600 ) , TARRYC600),  dcxsop (600) 

* 

COMMON  /INDATA/  DAXSOP, DAYSOP,  DAZSOP,  DNXSOP,  DNYSOP,  DNZSOP, 

S<  PHAOXP,  PHB02P,  PHC03P,  PNAOXP,  PNB02P,  PNC03P,  TARRY,  DCXSOP 

* 
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SUBROUTINE  XTRAC 
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!?>!?>!?>«?>!?>  &&>&>&>-<  Cr>  Qr>  (?> 


* XTRA 

PROGRAM  XTRAC 
C : 

* 

This  is  the  VAX  ver 

si  on  of  the 

D EC-1 0 N e c k D a t a 

■k 

•k 

■k 

Pack age  origin  al 1 y 

written  for 

Curt  Spenny. 

VAX  c o n ver si o n and 

enhancemen t 

by  Doug  Gordon 

■k 

Tweaking,  repairs. 

and  further 

enhancement  by 

■k 

R.  Stevens 

* 

SDC 

* Parameters  for  DCIFER.FOR 


BYTE  UNITS2C100) 

I NTEGER*2  NUMB 2 (100) 

I NTEQER  I NDX83 ( 41 ) , I NDX93 ( 44 ) , I NDX96 ( 1 ) , NUM , SUB , RECNUM 
NMTMP(S) ,VARTMP, INDX44C4) , INDX49(2) , 

INDX60 (2) , INDX64C6) , INDX65(5) , INDX67(5) , WRDTMP 
REAL  A( 801 ) , B( 801 ) ,C(801) ,MAX2(100) ,MIN2(100) ,SINIT 
CHARACTER'S  NAME 2 < 100), RUN 2 ( 1 0 0 ) 

CHARACTER* 5 LISTHC9) 

CHARACTER  NEWNAM*40 
character  dname*132 
character  f i In am* 30 , varnam*6 


INCLUDE  "XTRBLK/LI ST" 
include  " dsppl tblk , for/1 i st " 


DATA  L I ST/ " EXT " , /UMA/ , "ADD' , " SUB" , " DI R" , " END" , " CLE"  , 
"FIL" , "CON" , "DIV" , "NOR" , "GET" , "DSP" , "STA"/ 
DATA  L I ST 2/" RUN" , "SUB"/ 

DATA  LISTS/ "ALL"/ 

DATA  L I ST 4/ " OAR " / 

RUN  NUMBERS 

RUN  NUMBERS 


t of  lateral  test  runs 


DATA  L I STR/ " LX1 785 " , " LX1 793 " , " LX1 831 " , " LX1 860 " 
" LX1916" , "LX1960" , "LX1998" , "LX2010" , "LX2013" 
" LX2032" , "LX2056" , "LX2060" , "LX2072" , "LX2090" 
" LX2124" , "LX2137" , "LX214S" , "LX2151" , "LX2132" 
" LX2294 " , "LX2298" , "LX2302" , "LX2313" , "LX2326" 
' LX2341 " , " LX2355" , 

" LX1 454 " , " LX1 456 " , " LX1 457 " , 

" LX1458" , "LX1468" , "LX1470" , "LX1475" , "LX14S4" 
" LX1 50 1 " , " LX1 503"," LX1 504"," LX1 505"," LX1 507" 
" LX1 510"," LX1 512"," LX1 513"," LX1 524 " , " LX1 525 " 
"LX1528" , "LX1471" , "LX1474" , 
nbdl  lateral  test  runs 


, "LX1874 
, "LX2027 
, "LX2102 
, "LX2282 
, " LX 2 33 8 


, " LX1487 
, "LX1509 
, " LX1526 


" LX4050 " , " LX 4 052" , " LX4053" 
" LX405S" , " LX4G59" , "LX4060" 
" LX4071 " , "LX4073" , "LX4074" 
" LX4079" , "LX40S0" , "LX4081" 
" LX 40 88 " , " LX 40 89 " , " LX40  90 " 


, "LX4054" 
, "LX4068" 
, " LX40  75" 
, "LX 40 83" 
, " LX4092" 


, " LX4055" 
, "LX4069" 
, "LX4076" 
, " LX4084" 
, "LX4093" 


"LX4057 
" LX 40  70 
" LX4078 
" LX40S5 
" LX4094 
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& 

* LX4095' 

' LX4G97X 

9 

' LX  4 0 9 3 ■' 

9 

' LX 40 99 x 

& 

'LX4107' 

x LX  4 1 0 9 x 

9 

'LX4110' 

9 

" LX4111 ' 

& 

'LX4114' 

■'  LX  4 1 1 8 x 

9 

x LX  41 1 8 x 

9 

x LX41 1 9 x 

s 

■-LX4124- 

-LX 41 25x 

9 

•"  LX41 28 x 

9 

LX 41 28 x 

s 

' LX4131 ' 

x LX4133" 

9 

x LX41 34  •' 

9 

" LX4135X 

s 

' LX4139'- 

x LX41 40  x 

9 

x LX41 42x 

9 

'LX4143' 

S 

•'  LX4147'- 

/LX4148/ 

9 

" LX4149y 

9 

/LX4151/ 

! Start 

of  oblique 

test  runs 

& 

' LX2763' 

' LX2770 " 

9 

XLX2772X 

9 

XLX27S4X 

& 

XLX2786X 

XLX2799X 

9 

x LX2801 x 

9 

' LX2S13" 

S 

•'LX2S29-' 

x LX2843" 

9 

'LX2872' 

9 

x LX2S7S  "' 

S 

' LX2973" 

"LX2979'- 

9 

XLX2982X 

9 

x LX29S5 x 

S 

'LX3053-' 

•'  LX3061 ' 

9 

•'  LX30  85X 

9 

XLX3077X 

S 

XLX3093X 

x LX3097" 

9 

" LX3100 x 

9 

/LX3102X 

S 

' LX3129' 

" LX3133'" 

9 

"LX3145-' 

9 

x LX3148  -' 

s 

x LX3417' 

! new  nbdl  oblique 

test  runs 

S 

XLX4159X 

x LX4161 ' 

f 

' LX41 82 x 

9 

x LX4163" 

S 

' LX4167X 

' LX4163X 

' LX4170 x 

9 

x LX4171 x 

S 

' LX 4 235 x 

'LX4236' 

XLX4237X 

9 

x LX4238' 

s 

•'  LX4242X 

' LX4243' 

> 

XLX4244X 

9 

x LX4246' 

s 

' LX4249' 

x LX4251  •' 

XLX4259X 

9 

" LX4260 x 

s 

XLX4264X 

x LX42S5" 

j 

"LX4266X 

9 

'LX4268/ 

s 

x LX4271 ' 

'LX4276' 

» 

x LX4277" 

9 

x LX4280  x 

s 

' LX42S2X 

'LX4284' 

j 

XLX4286X 

9 

' LX4237X 

s 

' LX4291 x 

x LX4292" 

j 

'LX4293' 

9 

x LX4295" 

s 

'LX4298' 

x LX4301 ' 

x LX4302" 

9 

x LX4305-' 

s 

'LX4309' 

' LX4310 " 

j 

x LX4313" 

9 

XLX4314X 

! Start 

of  frontal 

test  runs 

S 

XLX3524X 

" LX3525 x 

9 

■'  LX3530 ' 

9 

x LX3531 x 

s 

'LX3537-' 

" LX3544  X 

9 

XLX354SX 

9 

* LX3550 x 

s 

XLX3578X 

x LX35S3" 

9 

x LX361 6" 

9 

x DOT307" 

s 

x DOT310  ' 

'D0T314' 

9 

x D0T331 x 

9 

" D0T332-' 

£< 

XD0T345X 

,'LXA100' , ' LX4104' , 
, 'LX4115' , / LX41 1 2 / , 
, XLX4120X  , ' LX4123' , 
, LX41 23  '■  , /LX413G/  . 
, 'LX4137'  , ■'  LX  41 3 S'  , 
, 'LX4144' , 'LX4145X , 
, 'LX4153' , 'LX4155  , 


, " LX2815'  , XLX2827X  , 
,'LX2316' , 'LX2955' « 
, 'LX2988'  , 'LX3Q49'  , 
, " LX3085"  , 'LX3089'  , 
, 'LX3106' , /LX3122/ , 
, 'LX3153'  , 'LX3158'  , 


, 'LX4164' 
, 'LX4172' 
, XLX4240X 
, 'LX4247' 
, 'LX426i' 
, y LX4269' 
, 'LX43Q3' 
, XLX42S3X 
, 'LX4296' 
, yLX4306/ 
, 'LX4316' 

, 'LX3536X 
, 'LX3558-' 
, yD0T3G8  -' 
, •'  D0T333' 


, 'LX4166'  , 
, 'LX4234' , 
, ' LX4241 " , 
, XLX4248X  , 
, 'LX42S3y , 
, ' LX 42 70  •'  , 
, 'LX4281/  , 
, x LX4290  ' , 
, ■'LX4287  - , 
, / LX 430  7-'  , 


, 'LX3573" 
, " DOT30  3 ' 
, ' D0T343 •' 


! new  nbdl 

frontal 

test  run 

S 

" LX3801 ' 

9 

XLX3809X 

S 

'LX3783-' 

x LX 3 78 5 

S 

-LX3793X 

9 

' LX3794X 

S 

XLX3303X 

9 

x LX3804" 

s 

x LX3314/ 

9 

XLX3815X 

s 

x LX3821 x 

9 

x LX3S22" 

s 

x LX3839" 

9 

' LX3840 x 

s 

' LX3913" 

9 

' LX3354" 

s 

XLX3358X 

9 

" LX3S69X 

s 

x LX3878 x 

9 

•'  LX3882X 

s 

'LX3889' 

9 

x LX3924 x 

s 

•'  LX390  3X 

9 

x LX3900  x 

& 

* LX3913" 

9 

'LX3914' 

s 

' LX3927X 

XLX3928X 

s 

" LX3939' 

x LX3940  x 

s 

'LX3982' 

x LX3946  X 

s 

x LX3954 x 

x LX 39 55 x 

s 

x LX3965" 

9 

x LX3968' 

s 

XLX3986X 

9 

x LX 3987 x 

s 

LX3994" 

9 

x LX3995/ 

x LX 3 82 4' 

x LX3779" 

9 

x LX 3 780 x 

x LX.37S2  ■' 

LX 37 8 6 x 

9 

'LX3788-' 

9 

•'  LX3739  - 

•-  LX 3 7 91  ■' 

•'  LX 3798  •' 

9 

" LX3797" 

9 

"LX3738'' 

•'  LX380  0 •- 

' LX3305' 

XLX3807X 

9 

•'  LX  380  8 - 

y LX  381 2' 

XLX3817X 

9 

XLX3813X 

9 

" LX3S19X 

LX 38 2 3X 

' LX 3 8 51 x 

9 

XLX3852X 

9 

x LX3333  ' 

x LX3S37 x 

x LX3841 x 

9 

' LX3842'' 

9 

XLX3872X  , ■'  LX390 1 x 

" LX3856-' 

x LX3380  x 

9 

x LX3S90  x , •'  LX 38 5 7 

x LX3870 x 

9 

x LX3S71 x 

9 

x LX3375  ■'  , y LX3S78  - 

' LX3883" 

9 

x LX3885  -' 

9 

•'  LX3SS6  -' 

x LX3SS7 x 

•'  LX3893X 

9 

/LX3894/ 

9 

' LX3S95-' 

x LX3S9S" 

/LX3904/ 

9 

' LX3906X 

9 

XLX390SX 

•'  LX 390 9"' 

XLX3916X 

9 

x LX3920  x 

9 

x LX3921  •' 

XLX3926-' 

x LX3942  -' 

-LX3953X 

9 

'LX3962-' 

x LX395S  ■' 

x LX3941  •' 

9 

* LX3944 x 

9 

xLX3945y 

LX3972  •’ 

/LX3948X 

9 

•'  LX3949  X 

9 

x LX3950  •“ 

■'  LX3951 

'LX 3 957 ' 

x LX3959'- 

9 

•'  LX3961  ' 

•'  LX3963  * 

x LX 39 69' 

x LX3970 x 

9 

•'  LX39S3-' 

"LX 39 35-' 

" LX3989X 

' LX3990 - 

9 

* LX3991 * 

' LX3993- 

" LX3997X 

9 

LX3998  ■' 

9 

•'LX3999-- 
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n sw  w s u data 

& " DOT 453 ■"  , " DOT 454 " , " T760 0 8"  , ' DOT 4 55 " / 


* 


* 


k 

k 


-k 


k 

k 

■k 

k 

k 

k 

k 


Subject  Numbers 

DATA  L I ST  H/ " HO 083 " , " H 0 0 9 3 ' , " H 0 0 9 6 " , " H 0 0 44" , 

& ' HO  049'  "H006G"  . "H0064" . "H0065" , "H0067"/ 


Mar  i abl  e Names 
DATA  LIST Q/  "TIME" 
& ' QHBOXS" , " QHCOXS" 

& " MAZXGS " , " MAZSGS " 

& "DAXSQS" , "DAYXOS" 
& " PHB02S" , " PHC03S" 

& ' ANXXOS " , " ANYXOS " 

& "VNXXOS" , "VNXSOS" 
& ' RNAOXS" , " RNBOXS" 

& ' DNYSOS " , " DNZXOS " 

& ' FNOOIS" , " FN0Q2S" 

Sc  "DCXXOS"  , "VAXSOP" 
& "RHCOXP" , "DAXSOP" 
S<  "PHC03P"  , "FHOOIP" 

Sc  "VNYSGP"  , "UNZSOP" 

& "DNYSOP" , "DNZSOP" 
Sc  "FN002P"  , "FN003P" 
Subject  Data 


" AAXXGS" 

, " AAYXOS" 

"MAXXOS" 

, "MAXSOS" 

" RHAGXS" 

, " RHBOXS" 

"DAYSOS" 

, "DAZXOS" 

"FHOG1S" 

, " FH0G2S" 

"ANZXOS" 

, " QNAOXS" 

"MNYXOS" 

, "MNYSOS" 

" RNCOXS" 

, "DNXXOS" 

"DNZSOS" 

, "PNAQXS" 

" FN003S" 

, " FN004S" 

"MAY SOP" 

, "MAZSGP" 

"DAYSOP" 

, "DAZSOP" 

" FH002P" 

, " FHGG3P" 

" RNAOXP" 

, "RNBOXP" 

" PNAOXP" 

, "PNB02P" 

" FNQ04P" 

/ 

, " AAZXOS" , "QHAOXS" , 
, "VAYXOS" , "MAYS OS" , 
, "RHCOXS" , "DAXXOS" , 
, "DAZSOS" , "PHAOXS" , 
, "FH003S" , " FH004S" , 
, "QNBOXS" , "QNCOXS" , 
, "MNZXOS" , "MNZSOS" , 
, "DNXSOS" , "DNYXOS" , 
, " PNB02S" , "PNC03S" , 
, " ACXXOS" , "MCXXOS" , 
, "RHAOXP" , "RHBOXP" , 
, "PHAQXP" , " PHB02P" , 
, "FH004P" , "MNXSOP" , 
, "RNCOXP" , "DNXSOP" , 
, "PNC03P" , "DCXSOP" , 


Subject  83 

DATA  INDX83/1 ,2,3,4,7,8,10 ,11 ,14,16,17,15,19,20 ,26,30 
Sc  34 , 36 , 38 , 40 , 42 , 44 , 48 , 49 , 50 , 51 , 54 , 56 , 57 , 58 , 60 , 62 , 63 , 67 
& 70,73, 75 , 77 , 79/ 


, S3 , 


Subject  93 

DATA  I NDX93/5 ,6,9, 12,13,15,21,22,23,24,27,28,29,31 
Sc  37 , 39 , 41 , 43 , 45 , 46 , 47 , 52 , 53 , 55 , 59 , 61 , 64 , 65 ,66,69, 71 
& 76,73, 80 ,81,82, 83 , 84 , 85 , 86/ 

Subject  96 


33 , 35 , 
72,74, 


DATA  INDX96/25/ 


Subject  44 

DATA  I NDX44/90 , 98 ,103,10 8/ 

Subject  49 

DATA  I NDX49/92 , 1 1 0/ 

Subject  64 

DATA  INDX64/88, 109, 96, 100 ,104,105/ 
Subject  60 

DATA  INDX60/91 ,93/ 

Subject  65 

DATA  I NDX65/87 ,95,99,102,10  7/ 
Subject  67 

DATA  I NDX67/89 ,94,97,101,106/ 


k 

k 

k 

k 


Array  to  indicate  how  to  obtain  data 
=0  Data  is  on  file 
=1  Integrate  once 
=2  Integrate  twice 

DAT  A OR EAT/ 7*0 ,1,0,1,0,1,4*0,2,1,2,1,2,1,13*0,1,0,1,0,1, 4*0 , 
2, 1,2, 1,2,1, 8*0 ,1,2, 3*1 ,13*0 , 3*1 ,13*0/ 

Gives  variable  number  stored  on  file  used  to  create  values 
DATA  GRIG/1 ,20 ,21 ,22,23,24,25,20 ,11 ,21 ,12,22,13,14,16,18,20 , 
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& 11,21,12,22,13,5,7,9,26,28,30, 32 , 52 , 53 , 54 , 55 ,56,57,52. 43 , 

& 53 , 44 , 54 , 45 ,46,43, 50 , 52 , 43',  53,44, 54 , 45 , 37.,  33 , 41 , 53 , 50 , 62  , 

& 64 , 66 , 66 , 66 , 2 , 3 , 4 , 1 5 , 1 7 , 19 , 2 , 3 , 4 , 6 , 8 , 1 0 , 27 , 23 , 31 , 33 , 34 , 35 , 

& 36 , 47 , 43 , 51 , 34 , 35 , 36 , 33 , 40 , 42 , 53 , 61 , 63 , 65/ ' 

* Unit  types  for  DSPLAY  labels 

DATA  UN I TYP/4 , 3*3 , 3*7 , 6*2 , 3*3 , 6*1 , 3*5 , 4*9 , 3*3 , 3*7 , 6*2 , 3*3 , 

& 6*1 , 3*5 , 4*3 ,3,2,1, 3*2 , 3*3 , 3*1 , 3*5 , 4*9 , 3*2 , 3*8 , 3*1 , 3*5 , 4*3/ 

* Flags  for  0=Sensc<r  l=F'hoto 
DATA  PHOT 0/60*0 , 32*1/ 


*** 

*** 

*** 


1000 


& 


10 

1010 


1020 

& 

6 

6 

6 


1030 


& 


& 


10  40 


START  OF  EXECUTABLE  CODE 


KSTAT=LIB*INIT_TIMERC ) 
i n_f lags  = 0 

call  plo t_quest i ons( i n_f lags , dsplay$ou t_f lags) 
WRITEC 6,1000) 

FORMAT C /23X ," Spenny  Neck  Data  Analysis  Package",/) 
CALL  OUTPUT_DATE_TIME( 78) 

PRINT  * 


SUB=0 
I CNT = 0 
I FPLAC=0 
I SUB=0 


RECNUM=0 
I BLANK=0 

QPENC  UNIT=1 , FI LE=" SCRTCH"  , STATUS* " UNKNOWN " , ACCESS= " D I RECT " , 
MAXREC=MREC , RECL=RECLEN , ORGAN I ZAT I ON=" RELATIVE" , ERR =05) 
READ ( 1 , REC=1 , ERR=1 0 ) NVAR , NAME , RUN , MAX , M I N , UN ITS , NUMB 
CLOSE (UNIT=1) 

NEXTRD=1 
NR I TEC  6,1010) 

FORMAT ( IX , "XTR>  " ,*) 

I QPT1=0 

CALL  DC I FER( 3 , 14 , LI  ST) 

IF(NHAT.EQ.l)  THEN 
GOTO  10 


ELSE  IFCNHAT.NE.5)  THEN 
NR I TEC  6,1020) 

FORMAT C IX , " So r r y - Can n n o t i den  t i f y t h i 
"Commands  are:  EXTRACT  ADD 


command" ,/lX, 


SUBTRACT 
C ON  ST ANT  N O RM A L I Z E DIVIDE 

FILE 


VMAGNITUDE" , 
DSPLAY" ,/lX, 
END" ,/lX, 


" DIRECTORY  CLEAR 

" GET"/) 

NR I TEC  6 , 10  30 ) 

FORMAT C IX ," Please  re-enter  complete  line"/) 

GOTO  10 
END  IF 

OPEN  C UN I T=1 , F I LE=" SCRTCH " , STATU S= " UNKNONN " , ACCESS= " D I RECT 
MAXREC=MREC , RECL=RECLEN , ORGAN I ZAT I ON=" RELATIVE" , ERR=05) 
N EXT R 0=0 


GOTO  C 110, 120 , 120 ,120,1 70 , 1 30 , 20 ,30,130,130,1 30 , 
140,130,131) , NRDNUM 
NR I TEC  6, 10 40) 

FORMAT  C /IX "[Internal  Confusion. . . ] " / ) 


/IX 


C-ll 


•k 

20 


■k 

30 


& 

1050 


1060 

& 


40 

50 

60 

1070 

& 

& 


10  71 

S< 


ST,:T  l Please  Call  a Programmer . . . ] ' 
' C L E A R ■'  C o mm  and 


NEXTRD=0 

CALL  DC I FER (3,1, DUM ) 

I F ( WHAT . NE . 2 ) nOaR=0 
IFCWHAT.EQ.2)  NVAR*IVAL 

WR I TE ( 1 , REC=1 ) NVAR , NAME , RUN , MAX , M I N , UN ITS, NUMB 
CLOSE ( UNIT=1 ) 

GOTO  10 


'FILE'  Command: 

READ ( 1 , REC=1 ) NUAR , NAME , RUN , MAX , M I N , UN ITS , NUMB 
CALL  DC I FER (3,1, DUMMY ) 

I F (WHAT  .NE  7)  GOTO  100 
NEWNAM=IMAGE( FCHAR : LCHAR ) 

OPEN ( UN IT=20 , F I LE=NEWNAM , STATUS- ' UNKNOWN  ' , ACCESS* ' D I RECT ' , 
MAXREC=MREC , RECL=RECLEN , ORGANIZATI ON*' RELATIVE' , ERR=100 ) 
WRITE ( 6 , 1050 ) 

FORMAT (IX, 'Variable  #s  or  ALL>  ' ,$•) 

NEXTRD=1 

CALL  DC I FER ( 3 , 1 , LI ST3) 
print  * , "what=' ,what 
I F (WHAT . EQ . 5)  THEN 
GOTO  80 

ELSE  I F (WHAT . EQ . 2)  THEN 
NEXTRD=0 
GOTO  40 
ELSE 

WRITE( 6,1060) 

F 0 RM  AT ( IX , ' Car  i abl es  mu  s t be  input  by  dir  ec  tor  y n umber  ' , 
IX,'  or  ALL  - FILE  command  ignored.'//) 

GOTO  70 
END  IF 

R E A D ( 2 0 , R E C = 1 , E R R = 5 0 ) N UMVA R , NAM E 2 , R UN  2 , MAX  2 , M I N 2 , UN I T S 2 , N 

GOTO  60 

NUMVAR=0 

IF( IVAL.GT.NVAR)  THEN 
WRITE( 6,1070)  IVAL 

FORMAT ( IX , 'Var i able  number  ',12,'  exceeds  number  of  ', 
'variables  extracted  - Check  di rectory .' ,/lX , 

'Copy  stopped  at  previous  variable.'//) 

GOTO  70 
ENDIF 

K O UNT  =N  UM  V A R+ 1 
if(kount.gt.39)t hen 
write(6,1071)kount 

f o rma t ( 1 x , ' Var i abl e n umber  ' , i 3 , ' ex ceeds  maxi mum  n umber 
lx, 'that  can  be  filed  (100).'/ 

1 x , ' Co p y stopped  at  p r ev i o u s variable. ' ) 

go  t o 70 
endif 

RUN 2 ( KOIJNT ) =RUN ( I VAL  ) 

NAME 2 ( KOUNT ) =NAME ( I VAL ) 
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1080 

& 

& 

70 


* 

* 

80 

90 

1090 

St 


100 

1100 


MAX 2 ( KG UNT ) =MAX ( I UAL ) 

MIN2C  K 0 UNT ) =M I N ( I UA L ) 

UN  I T S 2 ( K 0 UNT ) = UN  I T S C I U A L ) 

N UM  8 2 C K Q UNT ) =N  UM  B ( I UA  L } 

READ ( UN I T=1 , REC= I UAL-f-1 ) C EC  I I ) ,11=1, NUMB ( I UAL ) ) 

WR I TE ( 20 , REC=k ount+1)  C E ( I I ) ,11=1, NUMB ( I UAL  > ) 

N UMU  A R =N  UMU  A R+ 1 
I SAUQ=IUAL 

CALL  DC I FER  C 3 , 1 , DUMMY ) 

IF(WHAT.EQ.l)  THEN 
GOTO  70 

ELSE  IFCWHAT.EQ.2)  THEN 
GOTO  60 
ELSE 

NRITEC6,108Q)  ISAUQ 

FORMAT ( IX , " I 1 legal  characters  found  in  variable  ", 

''specification  line  - Last  variable  transferred'' , /IX , 
'was  ',12//) 

END  IF 

NR I TEC  20 ,REC=1)  N UMU A R , NAM E 2 , R UN 2 , MAX 2 , M I N 2 , UN I T 8 2 , N UM B 2 
CLOSE ( UNI T=2G ) 

CLOSE (UN I T=l) 

GOTO  10 

ALL  variables  selected  on  FILE 

Append  to  NENNAM 

NUMUAR=0 

READ C 20 , REC=1 , ERR=90 ) NUMUAR , NAME 2 , RUN 2 , MAX 2 , M I N2 , UN ITS2 , NUMB 
I F ( NUMUAR+NUAR . GT . 1 0 0 ) THEN 
WRITEC  6,1090) 

FORMAT ( /IX , " Appendi ng  to  the  specified  file  will  create  " , 
"more  than  100  var i ables . "/lx ," FI LE  command  aborted  - ", 
"Please  choose  another  file..."/) 

NR I TEC  6,1030) 

GOTO  10 
END  IF 

DO  11=1 ,NUAR 

K0UNT=I I +NUMUAR 
RUN 2 C K OUNT ) =RUN  C 1 1 ) 

NAME 2 C KG UNT ) =NAME  C I I ) 

MAX2C  KOUNT ) =MAXC 1 1 ) 

M I N2 C KOUNT ) =M I N C I I ) 

IJNITS2C  KOUNT ) =UN I TS C 1 1 ) 

NUMB2C  KOUNT) =NUMBC I I ) 

READ  C UN I T=1 , REC= 1 1+1)  CECN) ,N=1 ,NUMBC II)) 

WRITEC 20 , REC=koun t+1 ) (ECN) ,N=1 ,NUMBC II)) 

END  DO 

N =NU  A R+N  UMU  A P. 

NR ITE C 20 , REC=1 ) N , NAME 2 , RUN 2 , MAX 2 , MIN2 , UN I TS2 , NUMB 2 
CLOSE C UNIT=2G ) 

CLOSE  CUN I T=l) 

GOTO  10 


NR I TEC  6,1100) 

FORMAT C /IX , "An  error  has  occurred  in  the  file  specification", 


C-13 


% 


& 

/IX , PI  ease  specify  the  file  in  quotes  usi  n g '/AX  co  n Men  t i on  s 
GOTO  10 

-k 

110 

EXT  R.  A CT  c o mm  and: 
CALL  EXTRCT 
GOTO  10 

k 

k 

k 

120 

First  three  MATH  commands 

I CM D = W R DN UM - 5 ! changed  1 to  5 

NEXTRD=0 

CALL  MATH(ICMD) 

GOTO  10 

k 

k 

k 

130 

Last  three  MATH  commands 

I CMD=WRDNUM-5 
CALL  MATH(ICMD) 

GOTO  10 

k 

k 

k 

140 

The  'GET'  command  - read  a 8CRTCH  format  file  into  SORT CH . DAT 

CALL  DCIFER(9,1 , DUMMY) 

I FCNHAT .NE .7)  THEN 
NR I TEC 6,1100) 

NRITEC 6 ,1030 ) 

GOTO  10 

& 

Sc 

END  IF 

N ENNAM = I MAGE C FCHAR : LCHAR ) 

OPEN ( UNI T=21  , FI LE=NENNAM  , STATUS="  OLD-'  , ACCESS= D I RECT  " , 
MAXREC=MREC,RECL=RECLEN, ORGAN IZATION=/ RELATIVE" ,ERR=150 , 
readonly , def aul tf i le=' x tr ac$db : . dat y ) 

GOTO  ISO 

150 

1110 

Si 

WR I TE ( 6 , 1 1 1 0 ) NENNAM ( 1 : LLEN ( NENNAM ) ) 

FORMAT ( /IX , ' The  file  '..A,'  does  not  exist  or  is  not  in  SCRTCH 
x format.  GET  command  ignored. ") 

GOTO  10 

k 

k 

k 

k 

ISO 

The  file  exists,  so  delete  the  current  SCRTCH.DAT,  and  then 
copy  the  new  file  in. 

CLOSE ( UNI T=1 , DI SP=/ DELETE" ) 

OPENC  UNIT-1 , FI LE=/ SCRTCH' , STATUS* 'NEN'  ,ACCESS=/ DI RECT  " , 

£< 

MAXREC=MREC, RECL=RECLEN , ORGAN I ZAT I ON*'  RELATIVE x ) 
REA D( 21 , REC=1 ) NUAR ,NAME , RUN ,MAX ,MIN , UNITS , NUMB 
NR I TE ( 1 , REC=1 ) NVAR , NAME , RUN , MAX , M I N , UN I TS , NUMB 
DO  JN K = 2 , NUA R+ 1 

READC  UN I T=21  , REC=JNK)  ( EC  I I ) , I I =1  ,NUMBC  JNK-1 ) ) 

NR  I TEC  1 , REC=JNK)  C EC  1 1 ) , I I =1  ,NUMBC  JNK-1 ) ) 

END  DO 

1120 

CLOSE  C UN  I T =21 ) 

N R I T E C S , 1 1 2 0 ) N ENNAM C 1 : L L EN C N ENNAM ) ) 
FORMAT  C /IX  , A , su  ccessf  u 1 1 y copied  ' / ) 
GOTO  10 

* 


C-IU 


* 

* 


170 


★ 

* 

★ 

ISO 


* 

* 

* 


1S1 


* 

★ 


05 


1125 

190 

1130 


■'DIR command 

CALL  DIRECT 
GOTO  10 

DSPLAY  subsystem  - see  documentation  in  DSPLAY.FOR 

CALL  DSPLAY 
GOTO  10 

' STA  •' 

f i 1 n am=  ''scrt  ch . da  t " 
image=image( i c : lchar ) 
call  baway ( image) 
yar nam= image ( 1 : lien ( image) ) 
call  s t an  dev ( f i 1 n am , yarn am ) 
goto  10 


call  getdi r ( dnarne) 

wr i te( 6 , 1125) dnarne ( 1 : lien ( dnarne) ) 

formatdx  / Error  opening  scratch  file  in  directory 
lx, ‘'Cannot  continue  execution.') 


NRITEC  6 , 1130 ) 

FORMAT ( /IX End  of  execution 
CALL  LIB*SHOW_TIMER( ,1) 

CALL  LIB*SHOW_TIMER( ,2) 

CALL  LIB*SHON_TIMER< ,5) 

END 


- XTRAC'/) 

! Elapsed  t i me 
! CPU  time 
! Page  faults 
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SUBROUTINE  XTRBLK 
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SUBROUTINE  XTRBLK 


0001  BYTE  UNITSC  100),  PH0TCH92) 

0002  INTEGER *2  NUMB (100) 

0003  INTEGER  CREATC92).  OR IG ( 92 ) , UNITYP  < 92 ) > RECLEN,  MREC,  NVAR, WHAT, 

0004  & FCHAR,  WRDNUM,  IVAL 

0005  REAL  MAX ( 100 ) , MIN( 100 ) , E ( 598 ) , TARRAY ( 598 ) 

0006  . CHARACTER *6  NAME ( 100 ) , RUN ( 100 ) » LISTR ( 380 ) , LISTQ ( 92 ) 

0007  CHARACTER*^  LIST ( 14) » LIST2(2) , LIST3, LIST4 

0008  CHARACTER# 10  XRUN, ID, TEST. IMAGE*S0 

0009 

0010  COMMON  /INPUT/  IMAGE, NEXTRD,  IC,  FCHAR. LCHAR, WHAT, LSTPOS, 

0011  & WRDNUM,  IVAL,  VALUE 

0012  COMMON  /HEADER/  NVAR, NAME, RUN, MAX, MIN. UNITS, NUMB 

0013  COMMON  /INPEXT/  TARRAY, E 

0014  COMMON  /PHOTON/  PHOTO 

0015  COMMON  /DICTIO/  LISTR, LISTQ, LIST, LIST2, LIST3, LIST4 

0016  COMMON  /VARATT/  CREAT, ORIG, UNITYP 

0017 

0018  PARAMETER  <MREC=101> 

0019  PARAMETER  (RECLEN=598> 

0020 
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SUBROUTINE  ACCDIS 
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0001 

0002 

0003 

0004 

0005 

0006 

0007 

0008 

0009 

0010 

0011 

0012 

0013 

0014 

0015 

0016 

0017 

0018 

0019 

0020 

0021 

0022 

0023 

0024 

0025 

0026 

0027 

0028 

0029 

0030 

0031 

0032 

0033 

0034 

0035 

0036 

0037 

0038 

0039 

0040 

0041 

0042 

0043 

0044 

0045 

0046 

0047 

0048 

0049 

0050 

0051 

0052 

0053 

0054 

0055 

0056 

0057 


*r 

* 

«■ 

«• 

*• 

* 

* 

* 

# 

* 

* 

*• 

*■ 

* 

* 

* 

* 


* 

* 


<• 


SUBROUTINE  ACCDIS ( SINI T»  B,  A,  VINIT,  I0PT1,  PHOTO,  NUM,  TARRAY) 
ACCDIS:  Douglas  A.  Gordon 

Arcon  Corporation 

Calculate  velocities  and  displacements  from 
accelerations  (sensor  data)  or  velocities  from 
displacements  (photographic  data) 

- A(i)  is  input  ( acc e 1 erat i ons  or  displacements) 

V(i)  is  requested  output  in  REAL*8  format 

B(i)  is  requested  outut  returned  as  REAL*4 

TARRAY(i)  is  variable  time  step  array  for  photo  data 

SINIT  is  initial  displacement  @ time  T=0 

VINIT  is  initial  velocity  @ time  T=0 

I0PT1  = 1,  calculate  velocities 

= 2,  calculate  displacements 
PHOTO  = 1,  for  photographic  data  (variable  time  step) 

BYTE  PHOTO 

REAL  A (NUM), B( NUM),  TARRAY (NUM) 

REAL*8  DELT,  V(801  ),  8(801  ),  q,  ql 

K=NUM— 1 

IF  (PHOTO.  EG.  1 ) GOTO  3 
DELT=0.  0005/2. 

IF ( I0PT1 . EG.  2)  GOTO  2 

Calculate  velocities  from  accelerations,  (sensor) 

V( 1 > =DBLE ( VI NI T ) 


<r 

«• 


* 

* 

* 


DO  1 = 1,  K 

V(I  + 1 )=V(  I >+DELT*DBLE(  ( A ( I ) +A ( 1 + 1 ) ) ) 

END  DO 
GOTO  5 

Calculate  displacements  from  accelerations  (sensor) 

V( 1 >=DBLE(SINIT> 

S( 1 )=DBLE(VINIT) 

DO  1 = 1,  K 
11=1+1 

Q=DELT*DBLE ( ( A( I )+A(  II))) 

S ( I I ) =S ( I ) +Q 
Q1=DELT*(S( I )+S( II ) > 

V ( I I ) =V ( I ) +G 1 
END  DO 
GOTO  5 


Calculate  velocities  from  displacements  with  variable  time 
step  (photo) 

3 V( 1 )=VINIT 
DO  1=1, K 


C-20 


0053  DELT=TARRAY  < 1 + 1 ) -TARRAY ( I ) 


005? 

V< 1+1 )=<A< I+l)-A( I ) 

0060 

END  DO 

0061 

0062 

* 

Copy  REALMS  array  V i 

0063 

# 

program 

0064 

* 

0065 

5 

DO  1=1. NUM 

0066 

B ( I ) =V ( I ) 

0067 

END  DO 

0068 

RETURN 

0069 

END 

) /DELT 

nto  REAL#4  array  B for  return  to  main 
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SUBROUTINE  DSPLAY 
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Vdlr*************************TWc*************************************** 


* 

* 

* 

* 

* 

* 

* 

* 


SUBROUTINE  DSPLAY 

DSP:  Douglas  A.  Gordon 

Arcon  Corporation 

Plotting  module  of  the  Spenny  Neck  Analysis  Package. 
Currently  supported  with  the  TEKTRONIX  TCS  package,  the 
original  used  DISSPLA,  and  will  never  be  converted  to 
that  in  the  future.  There  is  no  3-D  plotting  under  TCS. 

integer*4  dsplay$num_cmds 
parameter  ( dsplay$num_cmds  = 11) 


byte  already_lasered/ . false ./ , plo t ted_somethi ng , delete_it, 

& copy_it 

INTEGER* 4 READ1 , READ2 ,XTMPLB , YTMPLB ,ZTMPLB , I 3READ( 4) , RECLN , 

& RECNM,PLSTC20 ,4) ,PLST3(20 ,5) ,N3PNT(3) ,NPLOT ,N3PL0T , KPLOT , 

& BAUDQ,  points(20),  out_flags,  tt_lun,  submi t_laser_f ile 

REAL  XMAX2 ,XMAX3 ,XMIN2 ,XMIN3 , YMIN2 , YMIN3 ,YMAX2 , YMAX3 ,ZMAX3 , 

& ZMIN3 , ARRAY1 ( 538) ,ARRAY2<593) , ARRAYS (598) , -xpl t ( 598 , 20 ) , 

& ypl t ( 598 , 20 ) 

CHARACTER  TTL*30 , dans*l , laser_f  i le*252 
CHARACTER*3  LI STD( dsplay*num_cmds) , LI STD1 , LI STD2 
CHARACTER*! 0 RNTMP ,XLABEL , YLABEL .ZLABEL , DUMMY ,NAMTMP , 

& LABEL(0 :9) ,rntmps(20) 

• byte  quit 

INCLUDE  'XTRBLK/LIST' 
include  'pltdef .for/list' 
include  'dsppltblk .for/list' 

* 

DATA  LI  STD/' D I R' ,'PLO' ,'PL3' ,'DIS' ,'END' , 'XTR' ,'COP' , 'XSC' , 

& 'YSC' , 'LAS',  'FIG'/ 

DATA  DUMMY/'  '/ 

DATA  LISTDl/'RUN'/ 

DATA  LI STD2/'TIM'/ 

DATA  LABEL/'  ' , 'METERS' , 'M/SEC' , 'M/SEC*SEC' , 'TIME' , 'RADIANS' , 

& ' NEWTON-M ' , ' RAD/SEC**2 ' , ' RAD I AN/SEC ' , 'NEWTONS' / 

***  START  OF  EXECUTABLE  CODE 

out_flags  = plt$m_box  + plt$m_xline  + plf$m_yline  + plf$m_nosym 
delete_it  = .true. 
copy_it  = .false. 

* The  scratch  file  is  opened  and  the  dictionary  information 

* is  read  from  the  first  record. 

* NVAR  = number  of  variables 

* NAME, 

* RUN  = arrays  of  100  6 character  fields,  var  names  & runs 

* MAX , 

* MIN  = arrays  of  100  reals,  min  or  max  for  each  NAME 

* UNITS  = array  of  100  bytes  containing  #'s  1-7 

* NUMB  = array  of  number  of  points  for  the  NAME  list 

OPEN(UNIT=l , FI LE=' SCRTCH' , STATUS=' OLD' ,ACCESS=' DI RECT' , 

& MAXREC=MREC,RECL=RECLEN, ORGANIZATION^ 'RELATIVE' , 

& I 0STAT=I OS) 
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READC1 ,REC=1 , IOSTAT=IOS)  NVAR ,NAME , RUN , MAX ,M IN , UNITS , 

& NUMB 
MARK=0 
NPLOT =0 
IVARN=0 
IWORD=0 
RECNM=0 
N3PLOT=0 
KPLOT=0 
qu i t = . false . 

* 

10  NEXTRD=1  ! read  new  card,  next  field! 

WRITE( 6,1000) 

1000  FORMAT (IX, "DSP > ' ,*) 

CALL  DC I FER ( 3 , dspl ay $num_cmds , LI  STD) 

NEXTRD=0  - ! read  same  card,  next  field! 

I F (WHAT . EQ . 5) 

& GOTO( 20 ,30 ,240 ,250 ,650 ,680 ,251 ,3000 ,3010 ,3050 ,3030) , WRDNUM 


IF(WHAT.EQ.l)  GOTO  10  ! if  end  of  card! 

WRITE( 6 , 1010 ) ! otherwise...! 

WRITE( 6,1020) 

1010  FORMAT( IX ,' Sorry  - cannot  identify  this  command',/ 

& lx, 'Commands  are:  PLOT  PL3D  DIRECTORY  DISPLAY',/ 

& lx,'  XTRAC  COPY  XSCALE  YSCALE' ,/ 

& lx,'  LASER  FIGURE  END'/) 

1020  FORMAT( IX ,' Please  re-enter  complete  line',/, lx) 

GOTO  10 

***  'DIRECTORY' 

★ / 

20  CALL  DIRECT 
GOTO  10 

***  'PLOT' 

★ 

30  CALL  DCI FER( 3 , 1 , LI STD1 ) ! look  for  RUN  following  PLOT 

I F(WHAT ,NE .5)  then 
rn  tmp=dummy 
ic=lstpos 
else 

CALL  DCI  FER(  6 jNL'AR , RUN)  ! check  for  valid  run  in  die. 

if (what . eq .5) then 
rn  tmp=run (wrdnum) 
else 

WRITE( 6,1030) 

WRITE( 6,1020) 

1030  FORMAT ( /IX ,' Run  number  must  follow  the  identifier  RUN'/) 

goto  10 
endi  f 
endi  f 

★ 

60  call  dcifer (3,1 ,listd2) 

if (what .eq .5) then  ! first  var  is  time 

readl=999 
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call  dci f er ( 3 , 1 , 1 i std2) 
if (what . eq .5) then 
read2=999 
goto  110 
else 

i c=lstpos 
do  j =1 , nvar 

if(run(j) .eq .rntmp) then 
n am  tmp  =n  ame ( j ) 
call  dcif er(6, 1 ,namtmp) 
if (what .eq .5) )goto  100 
i c=lstpos 
endi  f 
enddo 

wri te(6,1040) 
wr i te( 6 ,1050 ) 
wri te(6,1020) 
goto  10 
endi  f 
else 

i c=lstpos 
do  i=l,nvar 

if(run(i) .eq .rntmp) then 
namtmp=name( i ) 
call  dcifer(6,l ,namtmp) 
i f (what . eq . 5) then 
readl=i 


! second  var  is  time 


! second  var  not  time 


! if  same  run  # 

! check  for  right  var 
! right  var 
! keep  looking 

! 2nd  not  in  scrtch 

! first  var  not  time 

! check  for  right  run 

! check  for  right  var 
! if  right  var 


second  var 
it  is  time 


time  ? 


it  isn't  time 


call  dcif er(3,l ,listd2) 
if (what .eq .5) then 
read2=999 
goto  110 
else 

i c=lstpos 

do  j=l,nvar  ! look  for  var  in  scrtch 

if(run(j) .eq .rntmp) then 
namtmp=name( j ) 
call  dcif er(6,l ,namtmp) 
i f (what . eq . 5)  goto  100 
i c=lstpos 
endi  f 
enddo 

wr  i te( 6 ,1040 ) 
wr i te( 6 ,1050 ) 
wri te(6,1020) 
goto  10 
endi  f 
i c=lstpos 
endi  f 
i c=lstpos 
endi  f 
enddo 

wri te( 6 , 1040 ) 
wri te(6,1050) 
wri te(6,1020) 
goto  10 
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endi  f 

1040  f ormat (/lx , ' I npu t processing  shows  a run/variable  mismatch'/) 

1050  format  ( lx  , '*For  run/variable  info  use  the  DIRECTORY  command'/) 

★ 

100  READ2=J 

* 

110  I F( READ1 .NE . READ2)  GOTO  120 

WRITE( 6,1060) 

WRITE( 6 ,1020 ) 

1060  FORMAT (/lx , 'There  really  is  no  sense  in  plotting  the  same 
& variables') 

GOTO  10 

* 

120  CALL  DCI FER( 3 , 1 , DUMMY) 

i f (what . ne . 2 . and .what . ne . 1 ) then  ! non-integer  marker 

wr i te( 6 , 1069) 

1069  f ormat ( lx , 'An  integer  is  required  for  marker  value  (0-8)' 

&/lx, 'Please  try  again...',/) 

goto  10 

else  IF(WHAT.EQ.2.AND. IVAL.LE.8) then  ! a proper  marker  value 
goto  130 

else  i f (what . eq . 2 . and . i val . gt . 8) then  ! marker  values  only  to  8 
WRITE( 6,1070) 

1070  FORMAT ( IX , 'Marker  values  are  in  the  range  of  0-8  (integer)' 

& /lx, 'Please  try  again...',/) 

goto  10 

else  ! value  blank,  use  0 

IVAL=0 

endif 

* 

130  MARKER=IVAL 

IF(NPLOT.LE.O)  GOTO  140 

* 

* This  section  is  commented  out  to  allow  plotting  of 

* different  variables. 

* 

140  NPNT1=Q 
NPNT2=0 

150  I F( READ1 .NE . 999)  NPNT1=NUMB( READ1 ) 

I F ( READ2 .NE . 999)  NPNT2=NUMB( READ2) 

IF(READ1 .NE . 999 . AND . READ2 .NE . 999)  GOTO  190 

★ 

* ARRIVED  HERE  BECAUSE  ONE  VARIABLE  IS  'TIME' 

* 

I F (NPNT1 .NE . 598 . AND .NPNT2 .NE . 598)  GOTO  160 

NPNT1=598 

NPNT2=598 

GOTO  190 

★ 

160  DO  170  IJ=1,NVAR 

I F ( (NAME( I J) . EQ . 'TIME' .AND.RUN(IJ) . EQ.RNTMP) .or. 

& ( rn tmp . eq . dummy ) ) GOTO  180 

170  CONTINUE 

WRITE( 6 , 1100 ) 

GOTO  10 
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ISO  IF(READ1 .EQ.999)  readl=IJ 
I F( READ2 . EQ . 999)  READ2=IJ 
GOTO  150 

★ 

* CHECK  FOR  BOUNDED  PLOT 

* 

190  CALL  DCI FERC  3,1, DUM) 

IF(WHAT.EQ.l)  GOTO  210 
I F (WHAT .NE .2)  GOTO  200 
NPNT1=IVAL 

READ(1 , REC=READ1+1 ) ARRAY1 

CALL  MNMX( ARRAY 1 ,MIN ,MAX , READ1 ,NPNT1) 

NPNT2=IVAL  - 

READ( 1 , REC=READ2+1 ) ARRAY1 

CALL  MNMX( ARRAY 1 ,MIN ,MAX , READ2 »NPNT2) 

WRITEC1 ,REC=1)NVAR, NAME, RUN, MAX, MIN, UNITS, NUMB 
GOTO  210 

* 

200  WRITE( 6 , 1080 ) 

1080  FORMAT (IX, 'Unrecognized  user  input  following  plot  symbol', 

&'  ignored') 

★ 

210  IFCNPNT1 .EQ.NPNT2)  GOTO  220 
NRITE( 6,1090) 

1090  F0RMAT(1X,'A  mismatch  between  the  number  of  points  ' 

&,/,'  to  be  plotted  has  been  discovered.'/, 

& ' the  PLOT  command  will  be  ignored  ! ' ,/) 

GOTO  10 

* 

220  NPNT  =NPNT1 

NPLOT =NPLOT+l 
rn  tmps( nplo  t ) =rn  tmp 
PLST (NPLOT , 1 ) =READ1 
PLST ( NPLOT , 2 ) =READ2 
PLST ( NPLOT , 3 ) =MARKER 
PLST (NPLOT ,4) =NPNT 
230  GOTO  10 

1100  f ormat ( lx , 'TIME  variable  for  photographic  data  is  not  in  the',/ 
&'  SCRATCH  file  di rectory ',//' PLOT  request  is  ignored',/) 
■k-k-k-kk-k-k-k-k-k-k-k-k-k'k-k-Jrk-k-k'k-k-k-k-kkk-k-k-k-k-k-k-kk-k-k-k~k-k-kkkk-k-k-k-k-/rkk-k-k-k-k-k-k-k-k-k-k-k-k-k-k 
***  'DISPLAY' 

* 


250 


I F( NPLOT . EQ . 0 ) GOTO  640 
I F ( PLST (1,1) . EQ . 999)  THEN 
dsplay$xmin  =0.0 
dsplay$xmax  = 0.3 
dsplay$incx  = 3 

out_flags  = out_flags  + plt$m_xscale 


ENDIF 

I F( PLST ( 1 . 2) . EQ . 999)  THEN 


dsplay^ymi n 
dsplaySymax 
dsplay^i ncy 
ou  t_f lags  = 


= 0.0 
= 0.3 
= 3 

ou  t_f lags  + 


pi t$m_y scale 
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* 

* 

* 


ENDIF 


Start  the  plot 

TTLC  21 : 30 ) ='  ' 

I TLEN=20 

IF(PLST(1 ,1) .EQ.999)  THEN 
TTL  ( 1 : 1 0 ) = •'  T I ME 
ELSE 

TTL (1:10) =NAME ( PLST (1,1)) 

ENDIF 

IF(PLST(1 ,2) .EQ.999)  THEN 
TTLC11 :20)='TIME 
ELSE 

TTL (11:20) =NAME ( PLST (1,2) ) 
ENDIF 

IF(NPLOT.EQ.l)  THEN 
ITLEN=30 

IF(PLST(1 ,1) .NE.999)  THEN 
, TTLC 21 : 30 ) =RUN( PLST( 1 ,1) ) 
ELSEIF(PLST(1 ,2) .NE.999)  THEN 
TTLC  21 : 30 ) =RUN( PLST (1,2) ) 
ELSE 

ITLEN=20 

ENDIF 

ENDIF 

260  I F C PLST (1,1) . EQ . 999)  THEN 

XTMPLB=4 
ELSE 

XTMPLB=UNITS( PLST (1,1)) 

ENDIF 

IF( PLST (1,2) .EQ. 999)  THEN 
YTMPLB=4 
ELSE 

YTMPLB=UNITS( PLST (1,2)) 

ENDIF 

XLABEL=LABEL(XTMPLB) 

YLABEL=LABEL(YTMPLB) 

YP0S=9 . 2 

qu i t=. false . 

DO  I Q=1 ,NPLOT 

I F ( PLST ( I Q , 1 ) . EQ . 999)  GOTO  270 
RECNM=PLST ( I Q , 1 )+l 
READ( 1 , REC=RECNM) ARRAY1 
GOTO  290 

270  ARRAY1 ( 1 ) =0 . 0 

TIME= .0005 
DO  I K=2 , 593 

ARRAY 1 (IK) =ARRAY1 ( I K-l ) +T I ME 
end  do 
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290  IF(PLST( IQ,2) .EQ.999)  GOTO  300 

RECNM=PLST( IQ,2)+1 
READ(1 ,REC=RECNM)ARRAY2 
GOTO  320 

300  ARRAY2( 1 ) =0 . 0 

TIME= .0005 
DO  I S=2 , 598 

ARRAY2 ( I S ) =ARRAY2 ( I S-l ) +T I ME 
end  do 

320  call  1 i b$mo v c3  ( 2392 , arrayl,  xplt(l,iq)) 

call  1 i b$movc3( 2392 , array2,  yplt(l,iq)) 
points(iq)  = plst(iq,4) 
end  do 

i f ( already_Iasered)  then 
ttl  = ' ' 
xlabel  = ' ' 
ylabel  = ' ' 
else 

if ( (dsplay$out_f lags  .and.  plt$m_vt240)  .ne.  0) 

& cali  vt200_set_mode(4)  . 

endi  f 

call  dsp_overlay (xpl t , yplt,  points,  nplot,  598,  0,  ttl, 
& xlabel,  ylabel,  out_flags) 

do  iq  = 1,  nplot 

if(plst(iq,l) .eq .999) then 

call  lable( rn tmps( iq) , 'TIME  ' ,name(plst( iq ,2) ) , 

& qui t , plst( iq ,3) ) 

else  i f ( plst ( i q , 2) . eq . 999) then 

call  lable( rn tmps( iq) ,name(plst( iq ,1) ) , 'TIME  ', 

& qui t ,plst( iq ,3) ) 

else 

call  lable( rn tmps( iq) ,name(plst( iq ,1) ) , 

& name ( plst ( iq,2)) ,quit,plst(iq,3)) 

endi  f 

close(un  i t=87)  ... 
end  do 
qu i t= . true . 

ifCreadl  .eq.  999)  readl  = 1 
if(read2  .eq.  999)  read2  = 1 

call  lable(rntmp , name (readl) ,name(read2) , qui t) 
if (.not.  already_lasered)  then 
if(copy_it)  then 
call  hdcopy 
else 

call  plhold 
endi  f 

call  neupag 

if ( (dsplay$out_f lags  .and.  plt*m_ut240)  .ne.  0)  then 
call  v t200_set_mode( 5) 
endi  f 
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endif 

plo tted_somethi  ng  = .true. 

out_flags  = plt$m_box  + plt$m_xline  + plf$m_yline  + pi tSm_nosyrn 
copy_it  = .false. 

GOTO  660 

★Vc ■k-.kk-kkkkk-Jrkk-k-kkk-kkkkkkkk-Jrk-k-kkkkkkkkkkkkk'k-kkkkkkk-kkk-kkkkkkkkkkkkkkkk 

kkk  'XSCALE' 

* 


3000  its_x  = .true, 
goto  3020 


'c-krkkkkkkkk-k-k-k-k-k-kkkk 


**k  'YSCALE' 

★ 

3010  i ts_x  = .false. 

3020  call  dci f er ( 3 * 1 , dummy ) ! min  axis  value 

if(what  .eq.  3)  then 
qtmpl  = value 
else 

goto  - 4000 
endif  * 


call  dci fer ( 3 , 1 , dummy ) ! max  axis  value 

if(what  .eq.  3)  then 
qtmp2  = value 
else 

goto  4000 
endi  f 


call  dci f er ( 3 , 1 , dummy ) ! num  tic  marks 

if(what  .eq.  2)  then 
iqtmp  = ival 
else 

goto  4000 
endif 


4000 

4010 


if(its_x)  then 

dsplayfcxmin  = qtmpl 
dsplay$xmax 
dsplay^i ncx 
out_flags  = 
else 

dsplay$yrni  n 
dsplayfcymax 
dsplay^i ncy 
out_flags  = 
endif 
goto  10 
wr i te( 6 , 4010 ) 

f ormat < lx , ' Format  for  XSCALE  & YSCALE 
lx, 'COMMAND  <min-value>  <max-value> 
wr i te( 6 , 1020 ) 
goto  10 


= qtmp2 
= iqtmp 
ou  t_f lags 

= qtmpl 
= qtmp2 
= i q tmp 
ou  t_f lags 


+ pi t$m_x scale 


+ plt$m_yscale 


is:V 

< t i c-marks>  ■ 


***  'FIGURE' 
* 
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3030 

call  dcifer (32,1 , dummy) 
if(what  .eq.  7)  then 

dsplay^f i gur e = image( f char : lchar ) 
else 

3040 

wr i te( 6 , 3040 ) 

format(lx , 'Figure  title  must  be  enclosed  in  single  quotes') 
wr i te(6,1020) 
endif 

goto  10 

•kkk-kk-kkk*kkkkrk~kk-kkkk-kkkkirkkkkk-k-kkkrk-kickkk-kkkkkkkkkkrkkkkkkkrkk-k-k-k-kk-kk-kk 

***  * LASER' 

* 


3050 

if (already_lasered)  then 
wri te(6,3060) 

3060 

f ormat ( lx , 'The  laser  command  has  already  been  issued') 
goto  10 
endif 

3070 

already_lasered  = .true. 

ou  t_f lags  = ou  t_f lags  + pi t$m_laser 

call  setup_laser_f i le( ' ',  laser_file) 

wr i te( 6 , 3070 ) laser_f ile(l :llen(laser_f ile) ) 

format (lx , ' Ou tpu t plot  file  is  ',a) 

plot  ted_somethi  ng  = .false. 

goto  10 

★★★  ' co  p y ' 

* 


251 

copy__it  = .true, 
goto  250 

★ 

640 

1120 

wri te(6, 1120) 

format (/lx , 'No thi ng  to  plot  ! ') 
nplo  t=0 
goto  10 

•k 

660 

NPLOT =0 

N3PL0T=0 

KPLQT =KPL0T+1 

I F ( KPLOT . GE . 2)  KPLOT=0 

GOTO  10 

kk^kkkkkkirkrkirkirkkkifkirk^kkkkirkkkkkkkkkkkkkkkkkkkk-kkkkkkkkkkrk-kk-Jrk'kk 
kkk  ' PL3D" 

* 


240 

print  * 

print  *,  '3-D  plotting  not  currently  supported' 
print  * 
goto  10 

670 

1130 

MRITE( 6,1130) 

FORMAT (/IX, 'Error  OPENing  or  READing  SCRTCH  -') 
CALL  IOSMSG(IOS) 

680 

1140 

WRITE( 6 , 1140 ) 

F0RMAT(/1X, 'Returning  to  XTRAC'/) 
RETURN 

690 

if (already_lasered)  then 
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& 


1150 


i f C plo t ted_somethi ng)  then 

istat  = submi t_laser_f i le( ' SYS$MANAGER : TEKTRONIX .LIS' , 
laser_file,  delete_it) 

else 

inquire(file='tt'  , number  = t t_lun  ) 
close (uni t = t t_lun , di sp  = ' delete' ) 
en  d i f 
endi  f 


WRITE( 6,1150) 

FORMAT (/IX, 'End  of  execution  - XTRAC/D8PLAY'/) 
CALL  LIB$SH0W_TIMER( ) 
call  sy  s$ex  i t (%val  ( 1 ) ) 

END 
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SUBROUTINE  EXTRCT 
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*****-k-k**-k******-k********-k-k***************************************** 


******************************************************************** 


* 

* 

* 

* 

* 

* 

* 

* 

* 


SUBROUTINE  EXTRCT 

EXTRCT:  Douglas  A.  Gordon 

Arcon  Corporation 

The  EXTRACT  command  for  XTRAC.FOR.  This  is  the  data  read 
routine  for  the  Spenny  Neck  Analysis  package.  The  . EXT  files 
are  binary  files  containing  66  of  the  original  92  variables. 
Missing  variables  are  obtained  through  integration  or 
differentiation  of  existing  variables. 

REAL  A( 593) 

CHARACTER  FILENM*10 


INCLUDE  'XTRBLK/LIST' 


* 

* Check  next  word 

* 

NEXTRD=G 

CALL  DC I FER( 3 , 2, LI ST2) 

IFCWHAT.NE.5)  THEN 
WR I TE ( 6 s 1 0 0 0 ) 

1000  FORMAT ( ix , ' The  word  RUN  or  SUB  must  follow  EXTRACT'/) 

WRITEC  6,1010) 

1010  FORMAT C IX , ' Please  re-enter  complete  line') 

RETURN 
ENDIF  • 

* word  was  run  or  sub  - check  to  see  if  next  word  is  ALL 
NWORD=WRDNUM 
CALL  DCIFER(3,1 , LISTS) 

IFCNHAT.EQ.5)  THEN 
IRUN=999 
I SUB=Q 
GOTO  30 
ENDIF 
IC=LSTPOS 

I F (NMORD . EQ . 2)  GOTO  10 

CALL  DCI FER< 6 , 3S0 , LI STR)  (Check  for  c rrect  run  # 

IFCWHAT.NE.5)  THEN 
WRITEC  6,1020) 

1020  FORMATC IX , 'The  run  number  is  not  valid') 

WRITEC  6,1010) 

RETURN 

ENDIF 

I FPLAC=WRDNUM 
GOTO  20 


* check  subject  numbers 

10  CALL  DCI FERC  6 , 9 , LI STH) 

IFCWHAT.NE.5)  THEN 
WRITEC  6,1030) 

1030  FORMATC IX , 'The  subject  number  is  invalid') 

WRITEC  6,1010) 
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20 

RETURN 

ENDIF 

I SUB=NRDNUM 
I FC I RUN. EQ. 999)  ISU6=0 

30 

CALL  DCIFER(3,1 ,LIST4) 
I F (WHAT .NE . 5)  THEN 
NRITEC  6,1040) 

1040 

FORMAT  ( IX , ' Keyword  VAR  must  follow  RUN  or  SUB') 
NRITEC  6,1010) 

RETURN 

ENDIF 

* ALL 

or  variable  name 
CALL  DCIFERC3.1 , LISTS) 
IFCNHAT.EQ.5)  THEN 
RECNUM=999 
GOTO  50 
ENDIF 

40 

I C=LSTPOS 

1050 

& 

CALL  DC I FER( 6 , 92 , LI  STQ) 

IFCNHAT.NE.5)  THEN 
NRITEC 6, 1050) 

FORMATC IX , 'The  variable  name  is  not  in  the  list  of  legal', 
' variables.'/) 

NRITEC  6 , 1010 ) 

RETURN 

ENDIF 

IVNM=NRDNUM 

50 

60 

I FC  CREAT  CNRDNUM) .NE.0)  I OPTl=CREAT  CNRDNUM) 
RECNui;-0RIGCNRDNUM)*2-l 

I FCNNORD . EQ . 2)  GOTO  90  ! Select  by  subject 

I FC I RUN . EQ . 999)  I FPLAC= I FPLAC+1 
FI LENM=LI STRC I FPLAC)//' .EXT' 

£ 

& 

OPENCUNIT=20 , FI LE=FI LENM , ACCESS=' SEQUENTIAL' , STATUS=' OLD' , 
FORM=' UNFORMATTED' ,ERR=80 , I OSTAT=JXS , READONLY , 

DEFAULTFI LE=' x tr ac$dat : ' ) 

* 

READC20)  NUM.XRUN, I D .TEST , SINIT , VINIT 

NUM=M I NO C NUM , 598 ) !<<<  Mod  for  Curt  Spenny 

READ C 20)  CTARRAYC I ) , 1=1 ,NUM) 

RENIND  20 

I FC RECNUM . EQ . 999)  GOTO  70 
I F C RECNUM . NE . 1 ) THEN 
DO  I B=1 , RECNUM-1 
READC20) 

END  DO 
ENDIF 

READC20)  NUM.XRUN, I D .TEST , SINIT , VINIT 

print  3000,nvar,num,xrun,id,test,sinit,vinit 
NUM=MIN0  CNUM , 598)  I<<<<<<<<<<<<<<<<<< 

READC20)  CEC I I ) , I 1=1 ,NUM) 

CLOSE C UNI T=20 ) 

I 0PT1=CREAT  C I VNM) 

★ 

print  *,'I0PT1  =',ioptl,'  IVNM  =',ivnm 
IFCIOPT1.NE.O)  THEN 
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& 

& 


1065 

& 


70 

& 

& 


300  0 


1060 


CALL  ACCDIS(SINIT,A,E,UINIT, IOPT1 ,PHOTO( IUNM) ,NUM,TARRAY) 
DO  ITX=1 ,NUM 
E( I TX ) =A ( I TX ) 

END  DO 
ENDIF 

OPEN( UNIT=1 , FI LE=' SCRTCH' , STATUS= ' UNKNOWN ' , ACCESS=' DI RECT' , 
RECL=RECLEN,ORGANIZATION='RELATIUE' , ERR=80 , IOSTAT=JXS, 
MAXREC=MREC ) 

NUAR=NUAR+1 
i f ( n v ar  . g t . 1-0  0 ) t hen 

wr i te( 6 , 1065) name( nwar-1 ) 

f ormat ( lx , ' At  temp t to  EXTRACT  more  than  100  variables  -' , 
/lx, 'EXTRACT  stopped  at  variable  ',a/) 
nvar =nvar-l 
r eturn 
endi  f 

NAME  ( NUAR)  =L  I STQ  ( I UNM  ) 

RUN(NUAR)=LISTR( IFPLAC) 

CALL  MNMX ( E , M I N , MAX , NUAR , NUM ) 

UN I TS ( NUAR  ) =IJN  I TYP  ( I UNM  ) 

NUMB ( NUAR )=NUM 

WR  I TE  ( 1 , REC-l ) WAR  , NAME  , RUN  , MAX  , M I N , UN  I TS , NUMB 
IREC=NUAR+1 

WRITEC1 ,REC*IREC)  (E(II) ,11=1 , NUMB (NUAR) ) 

IFC I RUN. EQ. 399. AND. I FPLAC .NE . 92)  GOTO  60 
RETURN 

OPEN(UNIT=l , FI LE=' SCRTCH' , STATUS®' UNKNOWN' , ACCESS=' DI RECT' , 
RECL=RECLEN , ORGANIZATI 0N=' RELATIUE' , ERR=30 , I OSTAT=JXS , 
MAXREC=MREC) 

PRINT  * 

DO  IDD=1,S2 

RECNUM=ORI G( I DD)*2-1 
IF(ORIG( IDD) .NE.l)  THEN 
DO  I EX=1 , RECNUM-1 
READ (20) 

END  DO 
ENDIF 

READC20)  NUM,XRUN, I D ,TEST , SINIT ,UINIT 
print  3000,idd,num,xrun,id,test,sinit,vinit 
f o rma  t(lx,i2,')',i6,lx, 3al 0 , 2g ) 

NUM=M I NO ( NUM , 598 ) 

READ (20 ) (E( 1 1 ) , 1 1=1 ,NUM) 

WRITE( 6 , 1060 ) '*' 

FORMAT (1H+,A1 ,*) 

REWIND  20 

I F ( CREAT (IDD). NE . 0 ) THEN 
I0PT1=CREAT( IDD) 

print  * , ' Calculat i ng  variable  ',listq(idd) 

CALL  ACCDI S(SINIT ,A,E,UINIT , I OPT1 , PHOTO ( IDD) ,NUM ,TARRAY) 
' DO  IXZ=1 , NUM 

E( IXZ) =A( IXZ) 

END  DO 
ENDIF 

NUAR=NUAR+1 
I F ( NUAR . GT .100)  THEN 
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NR I TE (6,1070)  n ame( n v ar -1 ) 

1070  FORMATC/1X , ' At  temp t to  EXTRACT  more  than  100  variables  -' , 

& /lx, 'EXTRACT  stopped  at  variable  ',a/) 

RETURN 
END  IF 

NAME ( NVAR ) =L I STQ ( I DD ) 

RUN(NCAR) =LI STR( I FPLAC) 

CALL  MNMX ( E , M I N , MAX , NUAR , NUM ) 

UN I TS ( NVAR ) =UN I TYP ( I DD ) 

NUMB(NVAR) =NUM 

WR I TE ( 1 , RE'C=1 ) NL'AR  , NAME  , RUN  , MAX  , MIN , UN I TS , NUMB 
I REC=NL»AR+1 

NRITEC1  , REC=I  REC)  (E(  I ) , 1=1  ,NUMB(NL»AR)  ) 

END  DO 

I F( I FPLAC. NE. 110. AND. I RUN. EQ. 399)  GOTO  60 
RETURN 

80  print  * , ' OPEN  ERROR' 
call  iosmsg(jxs) 
return 

90  PRINT  *,  'No  select  by  subject  now...' 

RETURN 

END 


C-39/C-40 


SUBROUTINE  DCIFER 
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0001 

SUBROUTINE  DCIFER (NCLST, NDICT,  LIST) 

0002 

* 

DCIFER: 

Douglas  A.  Gordon 

0003 

«■ 

Arcon  Corporation 

0004 

* 

0005 

* 

Adapted  for  the 

VAX  from  the  similar  package  on  the  TSC 

0006 

’ * 

DEC-10.  Original 

author(s)  unknown. 

0007 

-M- 

0008 

V; 

This  is  the  command  parser  for  the  NECK  DATA  ANALYSIS 

0009 

*• 

PACKAGE  originally 

written  for  C.  Spenny.  See  XTRAC. 

0010 

V. 

. 

0011 

- FUNCTIONS  & SUBROUTINES  CALLED: 

0012 

0013 

CiiPRES 

External  Library 

0014 

C'TB 

External  Library 

0015 

- 

L*1  ISDIG 

External  Library 

0016 

1*4  LLEN 

External  Library 

0017 

* 

STRINP 

External  Library 

0018 

*■ 

1*4  TOINT 

External  Library 

0019 

* 

R*4  T0REAL2 

External  Library 

0020 

#• 

TTB 

External  Library 

0021 

0022 

BYTE  IFDP, ISDIG 

0023 

INTEGER  WHAT,  FCHAR 

, WRDNUM,  IVAL,  LLEN,  TOINT,  GET  STRING 

0024 

CHARACTER* < * > LIST(NDICT) 

0025 

CHARACTER  W0RD*10, 

IMAGE*80,  SQUOTE*!,  DELIM*3 

0026 

* 

0027 

* 

In  common  block 

INPUT: 

0028 

«• 

IMAGE 

=r 

80  character  command  "card" 

0029 

* 

NEXTRD 

= 

0,  Read  next  field  on  this  card 

0030 

* 

1»  Read  new  card,  first  field 

0031 

* 

2,  Reread  first  field  on  same  card 

0032 

*• 

1C 

= 

Pointer  to  current  card  column 

0033 

* 

FCHAR 

Location  of  first  char  in  string 

0034 

•* 

LCHAR 

= 

Location  of  last  char  in  string 

0035 

*• 

WHAT 

1,  End  of  card 

0036 

# 

2,  Integer  (returned  in  IVAL) 

0037 

*■ 

3,  Real  number  (returned  in  VALUE) 

0038 

<- 

4,  Word,  not  in  dictionary 

0039 

•K- 

5,  Word,  in  dictionary 

0040 

* 

6,  End-of-file  condition 

0041 

* 

7,  Character  string 

0042 

* 

8,  Illegal  char  in  numeric  field 

0043 

«■ 

LSTPOS 

= 

Beginning  location  of  last  field  read 

0044 

WRDNUM 

= 

Index  of  word  found  in  dictionary  list 

0045 

* 

I VAL 

= 

Integer  value  if  WHAT=2 

0046 

*- 

VALUE 

= 

Real  value  if  WHAT=3 

0047 

■B 

0048 

COMMON  /INPUT/ 

IMAGE,  NEXTRD,  IC,  FCHAR,  LCHAR,  WHAT,  LSTPOS, 

0049 

& 

WRDNUM,  IVAL, VALUE 

0050 

0051 

VALUE=0. 

0052 

IVAL=0 

0053 

WRDNUM=0 

0054 

LASTC=LLEN( IMAGE) 

0055 

SQUOTE= ' ' ' ' 

0056 

DELIM=  ' , 

/ 

! <space>,  <comma>,  <tab> 

0057 
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0058 

0059 

0060 

0061 

0062 

0063 

0064 

0065 

0066 

0067 

0068 

0069 

0070 

0071 

0072 

0073 

0074 

0075 

0076 

0077 

0078 

0079 

0030 

0081 

0082 

0083 

0084 

0085 

0086 

0087 

0088 

0089 

0090 

0091 

0092 

0093 

0094 

0095 

0096 

0097 

0098 

0099 

0100 

0101 

0102 

0103 

0104 

0105 

0106 

0107 

0108 

0109 

0110 

0111 

0112 

0113 

0114 


IF(NEXTRD.  EQ.  0)  THEN 

PRINT  *,  'IC:  ',  IC,  ' LC:  ',  LASTC 


print*, image(ic: lastc) 


IF(  IC.  LE.  LASTC)  GOTO  10 

WHAT=1 

RETURN 

ELSE  IF(NEXTRD.  EQ.  1 ) THEN 
CALL  STRINP( IMAGE, LASTC) 
LASTC=GET_STRING( IMAGE) 

IF  ( LASTC.  EQ.  O)  THEN 
WHAT  = 1 
RETURN 

ELSE  IF(LASTC.  EQ.  -2)  THEN 
WHAT=6 
RETURN 
END  IF 


print*-,  imaged:  lastc) 

CALL  CTB( IMAGE)  ! 

CALL  TTB  < IMAGE)  ! 

CALL  CMPRESI IMAGE)  ! 

LASTC=LLEN( IMAGE)  ! 

print*, imaged: lastc) 

IC=1 

ELSE  IFCNEXTRD.  EQ.  2)  THEN 


change  commas 
change  <tab>s 
convert  multip 
(possibly)  new 


to  spaces 
to  spaces 
le  spaces 
length  of 


to  one 
string 


space 


IC=1 


END  IF 


10  IF ( INDEX (DEL IM,  IMAGE ( IC:  IC ) ) . NE.  0)  THEN 
IC=IC+1 
GOTO  1 0 
END  IF 

PRINT  *,  'AFTER  10$  IC:  IC,  ' LASTC:  ',  LASTC 

IF(IC.  GT. LASTC)  THEN 
WHAT  = 1 
RETURN 
END  IF 

IF(IMAGE(IC: IC). EQ. SQUOTE)  THEN 
WHAT =7 
LSTPOS=IC 
FCHAR=IC+1 

LCHAR=INDEX( IMAGE (FCHAR:  >, SQUOTE) 

IF(LCHAR.  NE.  0)  GOTO  20 

WRITE (6, 1000)  IMAGE(1: LLEN( IMAGE) ) 

1000  FORMATdX,  'End  of  Record  within  string  ( DC IFER ) : ' /,  1 X,  A ) 

WHAT  = 1 
RETURN 

20  IC=LCHAR+1 

LCHAR=LCHAR+FCHAR-2 

RETURN 

ELSE  IF( ISDIG( IMAGE( IC:  IC) ). OR. 

& ( INDEX  ( IMAGE  (IC:IC)).NE.  0))  THEN 

IFDP=.  FALSE. 

DO  IB=IC,  LASTC 

IF  ( INDEX  ( '01234567B9+-.  ',  IMAGE<  IB:  IB  > ).  EQ.  0)  GOTO  30 
IFDP=  ( IFDP.  OR.  ( IMAGE(  IB:  IB).  EQ.  '.  ')) 

END  DO 
IB=LASTC+1 
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0115 

30 

IEND=IB-1 

01 16 

IF(IFDP)  THEN 

01 17 

WHAT=3 

01 18 

! 

print  *■»  imag  e ( i c : i end  ) 

0119 

VALUE=T0REAL2( IMAGE ( IC:  I END) ) 

0120 

IF  (VALUE.  EQ. -9999999.  ) GOTO  60 

0121 

ELSE 

0122 

WHAT =2 

0123 

i 

print  *,  'DCIFER:  IC:  ',  ic,  ' I END:  ',  iend 

0124 

IVAL=TOINT( IMAGE < IC:  IEND) ) 

0125 

IF  ( I VAL.  EQ.  -214  ’-83648)  GOTO  60 

0126 

END  IF 

0127 

IC=IEND+1 

0128 

RETURN 

0129 

ELSE 

0130 

LSTPOS=IC 

0131 

DO  ID— XC,  LASTC 

0132 

IF( INDEXCDELIM,  IMAGE( ID:  ID) ).  NE.  0)  GOTO  40 

0133 

END  DO 

0134 

ID=LASTC 

0135 

40 

WORD=IMAGE( IC:  ID) 

0136 

! 

PRINT  *■.  'At  50$,  WORD= ',  word 

0137 

DO  IE=1 , NDICT 

0138 

IF ( WORD ( 1 : NCLST ) . EQ. LIST < IE) ) THEN 

0139 

WRDNUM=IE 

0140 

WHAT=5 

0141 

GOTO  50 

0142 

END  IF 

0143 

END  DO 

0144 

WHAT=4 

0145 

ENDIF 

0146 

50 

IC=ID+1 

0147 

RETURN 

0143 

60 

WRITE ( 6, 1010) 

0149 

1010 

FORMAT( IX,  'Error  in  numeric  field  (DCIFER)') 

0150 

END- 
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SUBROUTINE  DIRECT 
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0001 

#*********•»**■*##*«*#•* -K-*-#*  •M--B-##******#*****##**##-!*-*#*#******##*#** 

0002 

*#*#******?**##******#*##*#*#*******#*##*#■* 

0003 

SUBROUTINE  DIRECT 

0004 

* DIRECT: 

0005 

#- 

Directory  of  SCRTCH.  DAT  for  XTRAC  and  DSFLAY 

0006 

* 

0007 

INCLUDE  'XTRBLK/LIST' 

0008 

0009 

READ<  1, REC=1 , ERR=10)  NVAR , NAME, RUN,  MAX,  MIN, UNITS, NUMB 

0010 

IFtNVAR.  EQ.  0)  GOTO  10 

0011 

DO  1=1, NVAR 

0012 

WRITE (6, 1000)  I, RUN ( I ) , NAME ( I ) , MIN( I ) , MAX ( I ) , NUMB < I ) 

0013 

1000 

FORMAT (IX,  13,  ')  2X,  2A10,  2(2X,  G),  15) 

0014 

END  DO 

0015 

RETURN 

0016 

10 

WRITE ( 6,  1010) 

0017 

1010 

FORMAT ( /IX,  'Empty'/) 

0018 

RETURN 

0019 

END 

C-46 


SUBROUTINE  STANDEV 


0001 

0002 

0003 

0004 

0005 

0006 

0007 

0008 

0009 

0010 
0011 
0012 

0013 

0014 

0015 

0016 

0017 

0018 

0019 

0020 
0021 
0022 

0023 

0024 

0025 

0026 

0027 

0028 

0029 

0030 

0031 

0032 

0033 

0034 

0035 

0036 

0037 

0038 

0039 

0040 

0041 

0042 

0043 

0044 

0045 

0046 

0047 

0048 

0049 

0050 

0051 

0052 

0053 

0054 

0055 

0056 

0057 


»**#"»«**#*fi"»«*  •************•**•**•»•■*****■**•***•■»•■»••*■**■*  *■■#■•*#•»•**#•*■**■*■•«■ *••*•*»■#■*■**■*•*■* 

subroutine  standev<  f i Inam*  varnam) 

* R.  Stevens 

* standev  is  called  by  xtrac  as  part  of  the  12/18/84 

* STA  command  for  the  Spenny  Neck  Analysis  SDC 

* package,  standev  opens  the  scratch  file  and  finds  all 

* occurances  of  the  passed  varnam  and  saves  the 

* corresponding  record  number  in  recnumr.  standev  then  calls 

* stdcal  to  get  values  for  the  mean  and  standard  deviation 

* at  each  timestep  for  the  set  of  varnam.  two  variables  are 

* then  calculated*  sigupi  mean  plus  st.  dev.  at  each  timestep* 

* - and  siglo*  mean  minus  st.  dev.  at  each  timestep.  The  scratch 

* file  is  then  rewritten. 

* 


real  mean(600),  sigup(600)*  siglo(600>*  stdev(600) 
character  f i lnam*30* varnam*6 
integer  varcount* recnumr ( 100) 
include  ' xtrbl k/list ' 

* 

open ( uni t=l.  f i le=f i lnam* status-' old access^ 'direct'* 
& organi zation='relative '» iostat-ios*  err=100) 


* 


& 


« 


2001 

2010 


2002 

& 


* 

* 


read (1. rec  = l*  i osta t=i os* err=110)nvar< name*  run. max, 
min,  units*  numb 

j=0 

minpts=600  ! 600  is  > we  need 

varcount=0 

do  i=l , nvar 

if (name(i).  eq.  varnam)then 

varcount=varcount+l  ! number  of  variables 

J-J  + l 

recnumr ( j )=i+l  ! keep  track  of  records 

if(numb(i).  It.  minpts)  minpts=numb ( i ) 
endif 
enddo 

if (varcount. eq. 0) then  ! make  sure  we  have  enough  vars 

write (6, 2001 ) varnam 

format(lx,  'The  variable  '* a,  ' is  not  in  the  scratch  file.  '/) 
write (6*  2010) 

format(lx,  'Please  try  again.  . . '/) 
return 

e 1 sei  f ( varc  ount.  eq.  l)then 
write (6. 2002) varnam 

format(lx,  'Variable  ',  a*  ' occurs  only  once  in  the  scratch 
file,  '/lx*  'STAing  it  wont  prove  anything.  '/) 
write(6* 2010) 
return 
endif 

call  stdcal (recnumr, minpts*  varcount*  f ilnam*  stdev*  mean) 
do  i=l*  minpts 

sigup ( i )=mean( i ) + stdev(i) 
siglo( i )=mean( i ) - stdev(i) 
enddo 
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0058 

*• 

0059 

meanr ec=nvar+2  ! prepare  info  for  scrtch  file 

0060 

si  gupr  ec‘=nvar+3 

0061 

siglorec=nvar+4 

0062 

nvsrl=nvar+l 

0063 

nvar2=nvar+2 

0064 

nvar3=nvar+3 

0065 

numb (nvarl )=minpts 

0066 

numb (nvar2)=minpts 

0067 

numb (nvar3)=minpts 

0068 

run(nvarl)='  ' 

0069 

. run(nvar2)='  ' 

0070 

run(nvar3)='  ' 

0071 

units (nvarl )=0 

0072 

units ( nvar2 ) =0 

0073 

units  Cnvar3)=0 

0074 

call  mnmx (mean#  min#  max#  nvarl#  minp ts ) 

0075 

call  mnmx (sigup#  min#  max#  nvar2>  minpts ) 

0076 

call  mnmx (siglo#  min#  max#  nvar3<  minpts) 

0077 

name (nvarl ) = 'M0'//varnam( 1:  3) //varnam< 6:  6) 

0078 

name (nvar2)= 'MP 7/varnam( 1:  3 ) //varnam ( 6:  6) 

0079 

name(nvar3)= 'MM '//varnam ( 1:  3) //varnam (6:  6) 

0080 

nvar=nvar  + 3 

0081 

! fix  scrtch  file 

0082 

wr i te ( 1#  rec  = l ) nvar#  name#  run#  max#  min#  units#  numb 

0083 

uir  i te  ( 1 # rec=meanr  ec  ) (mean(i)#i  = l.  numb  ( nvar  1 ) ) 

0084 

ujr  i te  ( 1#  rec=siguprec)  (sigup(i)#  i = l#  numb  ( nvar2 ) ) 

0085 

wr i te ( 1 » r ec  = si g 1 or ec ) (siglo(i)#  i=l,  numb (nvar3) ) 

0086 

* 

0087 

c 1 ose ( uni t=i ) 

0088 

* 

0089 

return 

0090 

100 

continue 

0091 

print  *#  'open  error' 

0092 

return 

0093 

110 

continue 

0094 

print  *.  'read  error' 

0095 

return 

0096 

end 

0097 
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SUBROUTINE  STDCAL 
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0001 

0002 

0003 

0004 

0005 

0006 

0007 

0008 

0009 

0010 
0011 
0012 

0013 

0014 

0015 

0016 

0017 

0018 

0019 

0020 
0021 
0022 

0023 

0024 

0025 

0026 

0027 

0028 

0029 

0030 

0031 

0032 

0033 

0034 

0035 

0036 

0037 

0038 

0039 

0040 

0041 

0042 
.0043 

0044 


* 

* 

* 

*• 

* 

* 

* 

* 

* 


subroutine  stdcal (recnumr, minpts,  varcnt.  filnam,  stdev, mean) 

s ideal  is  called  by  standev  as  part  of  the  R Stevens 

STA  command  of  the  Spenny  Neck  Analysis  12/1S/84 

package,  stdcal  allocates  virtual  memory  SDC 

and  then  loads  desired  arrays  (rec  nums  for  desired  arrays 
are  passed  in  recnumr)  into  one  large  array  in  virtual 
memory  this  array  is  passed  to  smean,  which  does  the 
calculations. 


character  filnnm*30 

integer  minpts.  varcnt,  recnumr ( varcnt ) , addrl.  addr2 
real  stdev(minpts),array( 600 ).  mean(minpts) 


nby tes=minpts*varcnt*4  ! size  of  total  vm 

nqui=nby  tes/8 

i f ( mod  ( nby  tes,  0 ) . ne  0)  nqw=nqui+l 
nvb-nqi)i«B 


kstat=l ib$pet_vm(nvb>  addrl ) ! allocate  vm 

i f ( . not.  k stat ) call  1 ib$stop  (V.val  ( kstat ) ) 


nby tes2=minpts*4  ! size  of  each  array 

addr2=addr 1 


do  i=l. varcnt  ! read  in  arrays 

read ( 1 , r ec=r ecnumr (i),  iostat-ios,  err  = 100  > 

& (array ( j ),  j=l.  minpts ) 

call  1 .i  b$movc3<  minp  ts*4,  array  ( 1 ) . */.va  1 ( addr2 ) ) 
ad  dr2=ad  dr2+nb  y tes2 
enddo 

* 

call  smean ( '/.va  1 (addrl ).  minpts,  varcnt,  stdev,  mean) 

* 

kstat=l ib$free_vm(nvb,  addrl ) 
i f (.  not.  k stat ) call  1 ib$signal  C/.val  ( kstat ) ) 

* 


return 

100  continue 

tur  i te  (6.  101 ) 

101  format (lx,  'READ  ERROR  in  module  STDCAL,  call  >a  programmer.  ') 
return 

end 
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SUBROUTINE  SMEAN 
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* 

* 

-k 

k 

k 

■k 

•k 

k 

k 

k 


k 


k 


su br  o u tine  smean (x,npts, n v ar  s , sdev , mean ) 

smean  calculates  the  mean  and 
standard  deviation  for  the  ST A 
command  of  the  Spenny  Neck  Analysis 

Package.  nvars  arrays,  each  npts  long  "are  packed 
into  x by  subroutine  stdcal.  The  mean  and  std.  dev. 
are  calculated  for  the  set  of  arrays  at  each  t irnestep  . 

real  x(npt s*n v ar  s ) , sdev ( n p t s ) , mean (npts) 


do  i =1 , np  ts  ! calc  mean 

koun  t = i 
xbar =0 . 0 
do  j =1 , nvars 

xbar=xbar  + x(kount)  ! sum  values 
kount=kount  + npts- 

enddo 

mean( i )=xbar/nvars 

enddo 

do  i =1 , np  ts  ! calc  std.  dev. 

koun  t = i 
sum=Q.O 
do  j=l,nvars 

sum=sum+ (x(kount) -mean ( i ) ) 
koun  t=koun  t+np ts 

enddo 

sdev  ( i ) =sqr  t ( surn/(  nvars-1 ) ) 

enddo 

return 

end 
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SUBROUTINE  MATH 
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0001 

0002 

0003 

SUBROUTINE  MATH ( ICMD ) 

0004 

-*  MATH: 

0005 

* 

Performs  the  ' VMA ' , 'ADD',  'SUB',  'CON',  'DIV', 

0006 

*• 

and  'NOR'  commands  for  XTRAC 

0007 

#■ 

0008 

BYTE  OK 

0009 

INTEGER  KEEP ( 3 ) , SI GLEN,  WKEEP ( 3 ) 

0010 

REAL  A (3, 598) 

0011 

CHARACTER  RSAVE*6,  VSAVE*6,  DUMMY*6,  Nr:WVAR*6 

0012 

- 

0013 

INCLUDE  'XTRBLK/LIST ' 

0014 

0015 

*■ 

Read  in  the  dictionary 

0016 

*■ 

0017 

READ(  1,  REC=1,  ERR=2010)  NVAR,  NAME,  RUN,  MAX,  MIN,  UNITS,  NUMB 

0018 

i 

do  i = l, nvar 

0019 

i 

print  name  < i ) 

0020 

i 

enddo 

0021 

* 

0022 

Keyword  RUN 

0023 

•* 

0024 

CALL  DCIFER(3,  1, LIST2) 

0025 

IF  (WHAT.  NE.  5)  THEN 

0026 

WRITE (6, 2000) 

0027 

2000 

FORMATdX,  'The  word  RUN  must  follow  the  command'/) 

0028 

WRITE (6, 1010) 

0029 

RETURN 

0030 

END  IF 

0031 

# 

0032 

■fr 

Run  number 

0033 

k- 

0034 

CALL  DCIFER(6,  380,  LISTR) 

0035 

IF  ( WHAT.  NE.  5)  THEN 

0036 

WRITE ( 6, 1000) 

0037 

1000 

FORMATdX,  'No  such  Run  Number'/) 

0038 

WRITE ( 6,  1010) 

0039 

1010 

FORMATdX,  'Please  re-enter  complete  line'/) 

0040 

RETURN 

0041 

END  IF 

0042 

1 

print  *,  'wt  dnum= '»  wrdnum 

0043 

RSA VE=L I STR ( WR  DNUM ) 

0044 

1 

print  *•,  'r save=  ',  rsave 

0045 

0046 

* 

Keyword  VAR 

0047 

«■ 

0048 

CALL  DCIFER  (3,  1,  'VAR') 

0049 

IF  (WHAT.  NE.  5)  THEN 

0050 

WRITE (6,  1020) 

0051 

1020 

FORMATdX,  'Keyword  VAR  is  missing'/) 

0052 

WRITE ( 6,  1010) 

0053 

RETURN 

0054 

END  IF 

0055 

*■ 

0056 

* 

Variable  name(s) 

0057 

* 
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0058 

0059 

0060 

0061 

0062 

0063 

0064 

0065 

0066 

0067 

0068 

0069 

0070 

0071 

0072 

0073 

0074 

0075 

0076 

0077 

0078 

0079 

0080 

0081 

0082 

0083 

0084 

0085 

0086 

0087 

0088 

0089 

0090 

0091 

0092 

0093 

0094 

0095 

0096 

0097 

0098 

0099 

0100 

0101 

0102 

0103 

0104 

0105 

0106 

0107 

0108 

0109 

0110 

0111 

0112 

0113 

0114 


1030 

1040 

10 

1050 

1060 

1070 

& 

* 


IF  < ICMD.  GT.  3 ) THEN 
IVEND=1 

ELSE  IF(  ICMD.  EQ.  1 ) THEN 
I VEND=3 
ELSE 

IVEND=2 
END  IF 

DO  IVKNT=1,  I VEND 

CALL  DCIFER(6, NVAR,  NAME) 

IF<  WHAT.  NE.  5 ) THEN 
print  ■*.  'what  = '»uihat 
WRITE (6,  1030) 

F0RMAT(1X,  'No  such  variable'/) 

WRITE ( 6, 1010) 

RETURN 
END  IF 

VSAVE=NAME ( WRDNUM ) 
print  *»  'vsave= ',  vsave 
DO  IA=1 , NVAR 

IF(RUN<  IA).  EQ.  RSAVE.  AND.  NAMEt  IA).  EQ.  VSAVE)  GOTO  10 
END  DO 

WRITE(6, 1040)  RSAVE. VSAVE 

FORMAT(  IX.  'Run  '.A.'  variable  '.A.'  has  not  been  EXTracted'/) 
WRITE(6. 1010) 

RETURN 

KEEP ( I VKNT ) = I A+ 1 
WKEEP ( I VKNT ) =NUMB ( I A ) 

END  DO 

IF(  ICMD.  EQ.  6)  GOTO  20 
IF  (ICMD.  GT.  3)  THEN 

CALL  DCIFER<6,  1. DUMMY) 

IF  (WHAT.  NE.  3)  THEN 
WRITE ( 6.  1050) 

F0RMAT(1X.  'Real  constant  is  missing  '/) 

WRITE ( 6,  1010) 

RETURN 
END  IF 

RCONST= VALUE 

IF ( RCONST.  EQ.  0.  0.  AND.  ICMD.  EQ.  5)  THEN 
WRITE ( 6.  1060) 

F0RMAT(1X.  'Real  constant  is  zero  - DIVIDE  ignored'/) 

RETURN 
END  IF 
ELSE 

0K=.  TRUE. 

DO  IZ=1. I VEND— 1 

0K=(  WKEEP  ( IZ).  EQ.  WKEEP  ( IZ+1  ) ).  AND.  OK 
END  DO 

IF  (.NOT.  OK)  THEN 
WRITE (6. 1070) 

F0RMAT(1X.  'It  is  not  possible  to  combine  sensor  and', 

' photo  variables  in  this  command.  '/) 

WRITE ( 6,  1010) 

RETURN 
END  IF 
END  IF 
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0115 

0116 

0117 

0118 

0119 

0120 
0121 
0122 

0123 

0124 

0125 

0126 

0127 

0128 

0129 

0130 

0131 

0132 

0133 

0134 

0135 

0136 

0137 

0138 

0139 

0140 

0141 

0142 

0143 

0144 

0145 

0146 

0147 

0148 

0149 

0150 

0151 

0152 

0153 

0154 

0155 

0156 

0157 

0158 

0159 

0160 
0161 
0162 

0163 

0164 

0165 

0166 

0167 

0168 

0169 

0170 

0171 


* 


20 


1080 

& 


* 

*■ 

* 


Get  'Use  Variable' 

CALL  DCIFER<6.  1, DUMMY) 

IF  ( WHAT.  NE.  7 ) THEN 
print  *.  'What  = '.what 
WRITE(6, 1080) 

FQRMAT(1X,  'The  "use  variable"  must  begin  with  an  alphabetic'/ 
/IX/  'and  be  enclosed  in  single  quotes'/) 

WRITE (6/ 1010) 

RETURN 
END  IF 

print  */ fcharz  lchar 
NEWVAR=IMAGE ( FCHAR : LCHAR) 
print  */ newvar 

Read  'em  in 


JNPTS=NUMB ( KEEP ( 1 ) - 1 ) 
print  *■/  ' jnpts='z  jnpts 
DO  IB=1, IVEND 

READ < 1 / REC=KEEP < IB ) ) <A(IB,  II),  11  = 1.  JNPTS) 

END  DO 

IF(  ICMD.  EQ.  6)  THEN 
RCONST=A( 1/  1 ) 

IFCRCONST.  EQ.  0.  0)  THEN 
WRITE  < 6>  1090) 

1090  F0RMAT(1X,  'Initial  value  zero  - NORMALIZE  ignored. 

RETURN 
END  IF 
ENDIF 

DO  70  IDK=1 , JNPTS 
print  *,  'icmd='/icmd 

GOTO  (30. 40,  50. 60. 60),  ICMD-1 


* 


-H- 


* 


# 


*■ 


* 

* 


' VMA ' 

E(  IDK)=SQRT(A(  1,  IDK)  *-*2+A(2»  IDK)**2+A(3,  IDK)**2> 
GOTO  70 

'ADD' 

30  E( IDK)=A( 1,  IDK)+A<2,  IDK) 

GOTO  70 

'SUB  ' 

40  E( IDK)=A< 1, IDK) -A (2. IDK) 

GOTO  70 

'CON' 


50  E< IDK)=A( 1, IDK)+RCONST 
GOTO  70 
'DIV'  Z<  'NOR' 

60  E( IDK)=A( 1, IDK)/RCONST 
70  CONTINUE 


Now  write  it  out 


* 


NVAR=NVAR+1 

RUN  < NVAR ) =RSAVE 

NAME ( NVAR ) =NEWVAR 

UN I TS ( NVAR ) =UN I TS ( KEEP ( 1 ) - 1 ) 

NUMB ( NVAR ) =WKEEP ( 1 ) 

CALL  MNMX(E, MIN,  MAX, NVAR,  JNPTS) 


/) 


•I 


; 

I 


C-5S 


0172 

0173 

0174 

0175 

0176 

0177 

0178 

0179 

0180 

0181 

0182 


WRITE! 1/ REC=i ) NVARi  NAME,  RUN,  MAX,  MIN,  UNITS, NUMB 
IQZX=NVAR+1 

WRITE! 1, REC=IQZX)  <E(II>, 11=1, JNPTS) 

RETURN 

<-  Error  exit 

# 

2010  WRITE(6,  2020) 

2020  F0RMAT(1X,  /No  Variables  EXTRACTed  — command  ignored'//) 

RETURN 
END 
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SUBROUTINE  MNMX 
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0001 

0002 

0003 

0004 

0005 

0006 

0007 

0008 

0009 

0010 
0011 
0012 

0013 

0014 

0015 

0016 

0017 

0018 

0019 

0020 


*****************  ***********  tf***********************-**-******-**-** 
*##*************#tt#tt*********fr****-***--»*-»--H-*tt-*-«--tt-**-H-**-*'»--»-*-»-**^-*  ■#•*-»* 

SUBROUTINE  MNMX (ARR,  MIN,  MAX,  NVAR > NUMMER ) 

* MNMX: 

* Find  the  min  & max  values  of  ARR  and  insert  in  MIN(NVAR) 

* and  MAX (NVAR) 

* 

REAL  MIN( 100), MAX( 100),  ARR(801 ) 

GNTMP=99999. 

QXTMP=— 99999. 

DO  1=1, NUMMER 

IF ( ARR ( I ) . LT.  QNTMP ) QNTMP=ARR ( I ) 

IF ( ARR ( I ) . GT.  GXTMP ) QXTMP=ARR ( I ) 

END  DO 

print*. 'MNMX:  min  max  nvar ' 

print  *, qntmp,  qxtmp,  nvar 

MIN (NVAR ) =GNTMP 

MAX (NVAR )=QXTMP 

RETURN 

END 
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SUBROUTINE  CURD 


0001 

0002 

0003 

0004 

0005 

0006 

0007 

0008 

0009 

0010 
0011 
0012 

0013 

0014 

0015 

0016 

0017 

0018 

0019 

0020 
0021 
0022 

0023 

0024 

0025 

0026 

0027 

0028 

0029 

0030 

0031 

0032 

0033 

0034 

0035 

0036 

0037 

0038 

0039 

0040 

0041 

0042 

0043 

0044 

0045 

0046 

0047 

0048 

0049 

0050 

0051 

0052 

0053 

0054 

0055 

0056 

0057 


subroutine  curd(xarr.yarr,npts. isymb  > 

* CURD.  Rick  Stevens 


* 

* 

# 

* 

* 

« 

* 

* 

* 

* 

* 

* 


SDC 

Aug  7 » 84 


From  a routine  by  Doug  Gordon: 

Routine  to  simulate  the  DISSPLA  CURVE  routine. 

XARR  is  x-axis  values.  YARR  is  y-axis  values.  NPTS  is 
number  of  points  to  plot.  ISYMB  is  the  symbol  to  use 
at  each  point.  If  ISYMB  is  > 0.  symbols-  are  drawn. 

If  ISYMB  = 0.  a solid  line  is  drawn.  If  ISYMB  < 0. 
dashed  lines  are  drawn.  Currently.  5 line  types 
are  supported. 

byte  outside 

real  xarr(mpts). yarr<npts > 

integer  jsymb(5)  ! line  types 

data  jsymb/54, 32,  312.  5434. 74/ 


shgt=0.  08  ! Symbol  height 

ksymk-1  ! determine  frequency  of  symbols 

if  (npts.  ge.  50)  ksymk=np ts/10 
if (npts. ge. 1000)  ksymk=npts/100 
i=0 

outsider,  true. 

call  seedwlvxn, vxx. vyn, vy x ) ! see  virtual  window 


do  while(outside)  ! while  inside  virtual  window 

i = i + l 

if (i.  gt.  npts)  return 
x=xarr ( i ) 
y=yarr  C i ) 

outside=(x.  It.vxn  or.  x.gt.  vxx  . cr.  ! Test  that  point  lies 
Sc  y.  It.  vyn  . or.  y.  gt.  vy  x ) ! in  virtual  window 

end  do 


call  movea ( xarr ( i ),  yarr ( i ) ) 

if  (isymb.  gt.  0)  call  symbo  1 ( xarr  < i ),  yarr  ( i ).  i symb,  shg  t ) 
isk=0 

do  j=i»  npts 

if  (isymb. gt.  0)then  ! want  symbol 

call  drawa ( xarr ( j ),  yarr ( j ) ) 

if  < j.  eq.  npts ) isk=ksymk  always  put  sym  on  last  pt 

if  ( isymb.  gt.  0.  and.  isk.  ge.  ksymk)  then 

call  symbol( xarr  < j ) . yarr  <j>,  isymb. shgt) 
isk=0  ! symbol  counter 

end  i f 

else  i f ( i symb . eq.  0 ) then  ! want  plain  old  line 

call  drawa  < xarr (j).yarr(j)) 

else  ! want  dashed  line 

k=*-i  symb 
jaz  z=>jsymb  ( k ) 

call  dasha( xarr( j ), yarr ( j >, jazz ) 
end  i f 
isk=isk+l 
end  do 


C-64 


see  screen  window 
place  cursor 
dump  output  buffer 


0058 

call 

seetw<  xm*  xx»  ym.  y x ) 

0059 

call 

movab  s ( xm»  y x ) 

0060 

call 

tsend 

0061 

return 

0062 

end 

SUBROUTINE  LABLE 
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■k-kk-k-k-k-k-k-k-kk-k-k-k-k-k-k-k-k-k-k-k-k-k-kk-Jck-k-kk-kk-k-k-k-k-M-k-k-k-k-k-k-k-k-k-k-k-k-k-.k-k-k-k-k-k-k-k-k-k-k-k-k-k-k-k-k 
k-kk-k-k-k-kk-k-k-k-k-k-k-k-k-k-k-k-k-k-k'k'k-k-k-k-k-k'k-kk-kk-k-k-k-k-k-k-kk-k-k-k-kk-k-k-k-k-k-kk-k-k-k-k-kk-k-k-k-k-k-k-k-k  , 
subroutine  lable( rn tmp , readl , r ead2 , qu i t , 1 i n typ ) 

byte  quit 

real  xar r ( 2) , y arr ( 2) 
integer  koun t , 1 type( 20 ) 
character*6  plo ts( 20 ) , rn tmp 
character  readies , read2*6 
character  str*24 
character*6  rl ( 20 ) , r2( 20 ) 
data  kount/G/ 

save  kount 

include  ' x trblk . for/1 i st " 
include  ' dsppl tblk . for/1 i st " 

if (.not. quit) then 

koun t=koun t+1  ! Note:  koun 

rl ( koun t ) =readl  ! value  when 

r2( koun t ) =read2  ! exited  and 

plo ts( koun t ) =rn tmp  ! value  upon 

1 1 y p e ( k o u n t ) =1  i n t y p 
return 
endi  f 

call  seetw(mi nx ,maxx ,mi ny ,maxy ) 
nmi nx=maxx 
nmaxx=1023 

call  csi ze( i horz , i ver t ) 

call  twi ndo ( nmi nx , nmaxx ,mi ny ,maxy ) 
call  dwindo(0 . ,360 . ,0 . ,200 . ) 
y y =200 . 
do  i=l, kount 
xx=30 . 
yy=yy-10 . 
call  movea(xx,yy) 

str=plots(  i )//"  V/(rl(  i ) <1  :llen(rl<  i ) ) ) )//'  vs  './/r2(i) 
cxx=xx+( llen(str)*ihorz) 
cyy=yy-( i ver  t/5) 
xarr ( 1 ) =xx 
xarr (2) =cxx 
yarr (l)=cyy 
y arr ( 2) =cyy 
call  tekout(str) 
enddo 
koun  t=0 

idfl  = lien ( dsplayfcf i gur e) 
if(idfl  .gt.  0)  then 

call  mo v abs( nmaxx -( i horz*( i df 1+5) ) , miny+2) 
call  tekout('Fig.  '//dsplay^f igured : idfl) ) 
call  tsend 
endi  f 

return 
end 


t retains  its! 
lable  is! 
has  that! 
return  to  lable 
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SUBROUTINE  SYMBOL 
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0001 

subroutine  symbo 1 ( x < y , isym>  sizin) 

0002 

# 

SYMBOL:  Douglas  A Gordon 

0003 

* 

Arc  on  Corporation 

0004 

* 

3— APR- 1984 

0005 

* 

0006 

Tektronix  routine  to  generate  a symbol  at  the  point 

0007 

<- 

(X.Y)  [assumes  a virtual  window  was  declared]. 

0008 

* 

ISYM  is  the  symbol  number.  SIZIN  is  the  symbol  size 

0009 

* 

in  inches.  Note  that  all  symbols  except  the  triangles  are 

0010 

# 

affected  by  rotation  of  the  plot. 

0011 

* 

0012 

* 

Modified  10-MAY-1984.  Added  3 new  symbols 

0013 

0014 

call  seedw< vxn, vx x, vyn, vy x ) 

0015 

if(x.  lt.vxn  .or.  x.gt.  vxx  .or.  1 Test  that  point  lies 

0016 

& 

y.  It.  vyn  .or.  y.gt.  vyx)  return  ! in  virtual  window 

0017 

call  movea(x.y)  ! move  to  point  in  virtual  coords 

0018 

call  seeloc ( i xa> iya ) ! get  the  position  in  screen  units 

0019 

ksi z=k in ( si z in  > 

0020 

irad=ksiz/2 

0021 

rad=f loat< irad ) 

0022 

sq32=sqrt(3.  0)/2.  0 

0023 

0024 

goto  ( 10,  20.  30,  40.  50.  60.  70),  isym-1  ! default  is  circle 

0025 

* 

0026 

* 

1 ) 

Circle  centered  on  (X.  Y)  radius  = IRAD 

0027 

* 

0028 

call  movrel ( irad.  0) 

0029 

do  ang=  10.  0.  360.  . 10.  0 

0030 

ixp=ixa+int(rad*sindfang) ) 

0531 

iyp=iya+int(rad*cosd(ang)) 

0032 

call  drwabs(ixp,  iyp)  ’ 

0033 

end  do 

0034 

goto  1000 

0035 

# 

0036 

* 

2) 

Square  centered  on  (X.Y)  . length  of  side  = KSIZ 

0037 

* 

' 

0038 

10 

call  movrel ( irad. -irad ) 

0039 

call  drwrel (0.  ksi z ) 

0040 

call  drwrel (-ksiz.  0) 

0041 

call  drwrel (0. -ksi z > 

0042 

call  drwrel ( ksi z.  0) 

0043 

goto  1 000 

0044 

* 

0045 

* 

3) 

Plus  sign  centered  on  (X.Y) 

0046 

* 

0047 

20 

call  movrel (-irad.  0) 

0048 

call  drwrel ( ks i z.  0) 

0049 

call  movrel C-irad. -irad ) 

0050 

call  drwrel (0.  ksiz ) 

0051 

goto  1000 

0052 

* 

0053 

* 

4) 

Equilateral  triangle  centered  on  (X.Y),  altitude  = KSIZ 

0054 

* 

0055 

30 

call  movrel (0,  irad ) ! apex  of  triangle 

0056 

i xp=i xa-int (rad*sq32) 

0057 

iyp-iya-irad 

! apex  of  triangle 


0058 

call  drwab s ( i x p . i y p ) 

0059 

i x p=i xa+i nt ( rad*sq32 ) 

0060 

call  drwabs ( i xp, iyp ) 

0061 

call  drwabs ( i xa. iya+irad ) 

0062 

goto  1000 

0063 

*■ 

0064 

* 

5) 

X centered  on  (X<  Y)  bounded  by  square  with 

sides  = KS I Z 

0065 

* 

0066 

40 

call  movrel <-irad» irad ) 

0067 

call  drwrel ( ksi z. -ksi z ) 

0068 

call  movrel <-ksiz.  0) 

0069 

call  drwrel < ks i z» k si z ) 

0070 

goto  1000 

0071 

* 

0072 

* 

6) 

Asterisk  centered  on  (X»Y)  bounded  by  square  sides  = KSIZ 

0073 

* 

0074 

50 

call  movrel (-irad. 0) 

0075 

call  drwrel ( ksiz.  0) 

0076 

call  movrel (-irad.  -irad > 

0077 

call  drwrel (0>  ksiz ) 

0078 

call  movea( x. y ) 

0079 

call  movrel (-irad. irad ) 

0080 

call  drwrel ( ks i z. -k si z ) 

0081 

call  movrel (-ksiz.  0) 

0082 

call  drwre 1 ( ks i z.  k si z ) 

0083 

goto  1000 

0084 

* 

0085 

* 

7) 

Upside-down  triangle 

0086 

* 

0087 

60 

call  movrel (0. -irad ) 

• 0^88 

i xp=i xa-int (rad*sq32) 

0089 

iy p=iya+irad 

0090 

call  drwabs ( ixp.  iyp ) 

0091 

i xp=i xa+(rad+sq32) 

0092 

call  drwabs(ixp.iyp) 

0093 

call  drwabs ( i xa. iya-irad ) 

0094 

goto  1000 

0095 

* 

0096 

* 

8) 

Diamond 

0097 

* 

0098 

70 

call  movrel (-irad.  0) 

0099 

call  drwrel ( irad.  irad ) 

0100 

call  drwre 1 ( irad. -irad ) 

0101 

call  drwrel (-irad. -irad ) 

0102 

call  drwrel (-irad.  irad ) 

0103 

goto  1000 

0104 

* 

0105 

* 

Insert  additional  figures  here 

0106 

* 

0107 

0108 

1000 

call  movea(x.y)  ! restore  original 

position 

0109 

return 

0110 

end 
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SUBROUTINE  TITLE 
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0001 

0002 

0003 

0004 

0005 

0006 

0007 

0008 

0009 

0010 
0011 
0012 

0013 

0014 

0015 

0016 

0017 

0018 

0019 

0020 
0021 
0022 

0023 

0024 

0025 

0026 

0027 

0028 

0029 

0030 

0031 

0032 

0033 

0034 

0035 

0036 

0037 

0038 

0039 

0040 

0041 

0042 

0043 

0044 

0045 

0046 

0047 

0048 

0049 

0050 

0051 

0052 

0053 

0054 

0055 

0056 

0057 


************************************************ -a- 


* 

*■ 

# 

* 

* 

« 

* 

*• 

* 

* 

* 

* 


subroutine  title 
TITLE: 


ttl,  lttl,  x lab  1 


lx,  y lab  1»  ly , duml,  dum2) 
Douglas  A.  Gordon 
Arcon  Corporation 
08— FEB— 1984 


Routine  to 
tektronix 
lengths  in 


emulate  the  DISSPLA 
PLOT— 10.  DUlil  & 
DISSPLA.  but  aren't 


TITLE  routine 
DUM2  are  the 
needed  here 


using 

axis 


- Modified 
passed 


09-MAY-1984  to  skip  over 
with  a length  of  zero  or 


titles  or  labels 
blank  strings 


Modified  20-Jul-1984  to 
eliminate  integer  storage 


use  TEKOUT,  and 
arrays  for  strings. 


to 


integer  ychar 

character  tt 1*<  *) » xlabl*(*),ylabl*(*) 


call  seet«u(  i xn»  i x x , iyn,  i y x ) 

lhl=linhgt<2) 

luil-1  inwdt  (0) 

if  ( ttl.  eq.  ' ' ) 1 1 1 1=0 

if(xlabl.eq.  * ')  lx=0 

if(ylabl.eq.  ' ')  ly=0 

i f ( 1 ttl.  gt.  0)  call  centre(ttl) 

if(lx.gt.O)  call  c entr  e ( x lab  1 ) 

if(ly.gt.O)  call  c entr  e ( y lab  1 ) 


i f ( Itt  1.  gt.  0)  then 

ixpos=ixn+(ixx-ixn-linwdt(len(ttl) ) >/2 
iypos=iy x + <780-iy x >/2 
call  movabs ( i xpos.  iypos) 
call  tekout ( ttl ) 
end  if 


if  ( lx.  gt.  0)  then 

ixpos=ixn+< ixx-ixn-1 inwd  t(len(xlabl)))/2 
call  movab s ( i x p os,  1 inh g t ( 1 ) /2> 
call  tekout(xlabl) 
end  i f 

if  ( ly.  gt.  0)  then 
i 1 h = 1 inhgt ( 1 ) 

iypos=iyx-<iy  x — i y n— 1 inhgt<len(ylabl))>/2 
do  i = l , 1 1 en ( y lab  1 ) 

ychar=ichar<ylabl < i: i ) ) 
call  movabs ( lwl, iypos ) 
call  ancho(ychar) 
iypos=iypos-ilh 
end  do 
end  if 


call  tsend 

return 

end 
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SUBROUTINE  DSP-WPAGE 


kkkkkkkkkkzkkkkkkkkkkkkkkkkkkkkkzkkkkkkkkkkkkkkkkkkkkkk-k:k-k-k-k-k-k-k-k’k-k 
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k 
k 
: k 
k 
■k 
■k 
■k 
k 
* 
* 


su br o u tine  dsp_wp age ( xsize, ysize, x 1 en , y 1 en ) 

N PAGE  : D o u g 1 a s A . G o r d o n 

A r c o n C o r p o rati o n 
08— FEB— 1984 

Routine  to  establish  the  logical  terminal  window  for 
a tektronix  terminal.  Attempts  to  somewhat  duplicate 
the  DIS3PLA  PAGE  routine.  XSIZE  is  x page  length  in 
inches,  YSIZE  is  the  y page  length  in  inches.  XLEN  is 
the  x-axis  length  and  YLEN  is  the  y-axis  length 


parameter ( max x =10 24) 
parameter (max y =780 ) 


! 


ixpts-int  ( x 1 en/x  s i z e*f  1 o a t ( max  x ) ) 
i y p t s= i n t ( y 1 en/y s i z e*f 1 o a t (max y ) ) 

ixn=150  ! mod  by  richs! 

ixx=ixn+ixpts 
i y n = ( max  y - i y p t s ) /2 
i yx  = i yn+i yp  ts 

call  tw i n do  ( i x n , i x x , i y n , i y x ) 

return 

end 
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SUBROUTINE  DSP-OVERLA Y 
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kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk 
Subroutine  Dsp_Overlay (X , Y,  Npts,  Ncurv,  Maxpts,  I sym , 

& Ttl,  Xlabl,  Ylabl,  Flags) 
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* 

* 

* 
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OVERLAY:  Douglas  A.  Gordon 

Arcon  Corporation 
16-Apr-1985 

Created  from  OMNI  PLOT. FOR 
Last  Revision  Date:  Thu  5-Dec-35  14:07 
Abstract : 


Simple  overlay  plotting  routine. 


Calling  Sequence: 


CALL  OVERLAY ( X.rf.ra,  Y.rf.ra,  NFTS.rl.r,  NCURV.rl.r, 
MAXPTS. rl.r,  I SYM. rl.r,  TTL.rt.dx,  XLABL. rt.dx, 
YLABL. rt.dx,  FLAGS. rl.r) 

Formal  Parameters: 


X 

Y 

NPTS 

NCURV 

MAXPTS 

ISYM 

TTL 

XLABL 

YLABL 

FLAGS 


Two-dimensional  array  (dimensioned  (MAXPTS , NCURV ) ) 
of  X-coordi nates  for  plotting.  Passed  by 
reference. 

Two-dimensional  array  (dimensioned  (MAXPTS , NCURV ) ) 
of  Y-coordi nates  for  plotting.  Passed  by 
reference . 

Array  (dimensioned  (NCURV))  containing  the  number 
of  points  to  plot  for  the  corr espondi ng  X and  Y 
arrays.  Integer*4.  Passed  by  reference. 

Number  of  curves  to  plot.  Used  as  the  implied 
dimension  of  X,  Y,  and  NPTS.  Integer*4.  Passed 
by  reference. 

The  upper  dimension  for  the  number  of  points  in 

the  arrays  X and  Y.  Integer*4.  Passed  by  reference. 

The  starting  symbol  value.  . Ignored  if  bit  8 of  FLAGS 
set.  Set  to  one  if  zero  or  negative  and  bit  8 clear. 
I n teger*4 . Passed  by  reference. 

Title  for  plot.  Passed  length  character 
string.  Passed  by  descriptor. 

Label  for  X-axis.  Passed  length  character 
string.  Passed  by  descriptor. 

Label  for  Y-axis.  Passed  length  character  . 
string.  Passed  by  descriptor. 

Plot  customization  flags.  Integer*4.  The 
following  bits  are  defined: 


Bit  Meaning  if  set 


Value 


0 

1 

2 


Draw  box  axes 

Draw  line  at  Y=0 . 0 (virtual) 
Draw  line  at  X=0 . 0 (virtual) 


1 

2 

4 
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* 

* 
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★ 
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★ 

* 

* 

* 

* 

* 

* 

* 


3 

4 


6 

7 

8 
9 

10 

11 

12 

13 

14 

15-31 

Implicit  Inputs: 
None . 

Implicit  Outputs: 


Draw  a point  grid  on  the  plot  8 
Auto  Hardcopy  plot  16 
Invoke  VT240/241  for  duration 

of  plot  - exit  to  VT10  0 mode  32 
X-axis  scale  from  common  64 
Y-axis  scale  from  common  128 
Suppress  symbols  256 
Dashed  lines  (not  currently 

supported)  512 
Used  by  the  legend  software  1024 
Rotate  auto-hardcopy  ((71240  with 

V2.1  firmware  or  later)  2048 
Draw  a scatter  plot  rather  than 

a curve  4096 
Laser  printer  support  8192 
Enable  message  trapping  16384 
Undefined  (must  be  zero) 


Plot  to  the  terminal. 


Side  Effects: 


Plays  with  the  emulations  settings  on  VT240  series  terminal 
Functions  & Subroutines  Called: 


1*4 

1*4 


1*4 


1*4 

1*4 


AXES1 

BAUDQ 

GET_ARRAY 

HARD_COPY 

HA  R D_C  0 P Y_F  F 

INITT 

LIB^SIGNAL 

LLEN 

MTITLE 

NEWPAG 

N_CURVE 

N_S  PLATTER 

PARS  E_B I T_F LAGS 

PLHOLD 

PUTMSG 

QUI ET_PLOT 

SCAL 

VT200_SET_MODE 

WPAGE 


TSC 

TSC 

TSC 

TSC 

TSC 


Plot 
Plot 
Gener 
Plot 
Plot 
TEKTRONIX 
VAX  Run  T 
TSC  Gener 
TSC  Plot 
TEKTRONIX 
TSC  Plot 
Plot 
Gener 
Plot 
Gener 
Plot 
Plot 
Gener 
Plot 


TSC 

TSC 

TSC 

TSC 

TSC 

TSC 

TSC 

TSC 


Li brary 
Li brary 
al  Library 
Li brar y 
Li br ary 
Terminal 
ime  Librar 
al  Library 
Li br ary 
Terminal 
Li br ary 
Li brary 
al  Library 
Li br ary 
al  Library 
Li br ary 
Li br ary 
al  Library 
Li br ary 


Control  System 
V 

(MACR032) 
Control  System 

(MACR032) 

(MACR032) 


Revision  History: 


Some  revision  history  removed  on  conversion. 
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Modified  10-Jun-1985  to  support  additional  functionality  in  VT240's 
with  firmware  upgrade. 

Modified  ll-Jun-1985.  Moved  the  rotate  code  since  VT240  doesn't 
recognize  escape  sequences  in  Tek  emulation. 

Modified  2S-Jun-19S5.  Changed  AXES_MASK  to  pass  additional  bits. 

Modified  9-Jul-1985  to  support  new  hardcopy  software. 

Modified  23-Jul-1985.  Added  call  to  RECOLOR. 

Modified  10-Sep-1985  to  return  VT240's  to  VT240  7-bit  controls 
rather  than  VT100  emulation  (VMS  V4.1  upgrade) 

Modified  19-Sep-1985  to  allow  scatter  plots. 

Modified  15-Nov-1985  to  include  a stab  in  the  dark  to  support  the 
laser  printer. 


byte  first/*,  true./,  autohc,  vt240,  bi  t_values(  0 : 31 ) , manualx  , 

& manualy,  no_sym,  rotate,  scatter,  laser 

integer*4  ncurv,  npts(ncurv),  flags,  max_bit,  status,  axes_f lags , 

6 axes_mask/' 0000003F'X/ , lttl,  lx,  ly,  jsym,  maxpts 

integer*4  par se_bi t_f lags , baudq , lien,  get_array,  putmsg 

real  x (maxp ts , ncurv ) , y (maxp ts , ncurv ) , xmin,  xmax , ymin,  ymax , tmp(2) 

eharacter*(*)  ttl,  xlabl,  ylabl,  esc*l/27/ 


include  ' pi tdef . f or/li st ' 

include  ' pi tmsgdef . for/1 i st ' ! 40  lines 

include  ' dsppl tblk . for/1 i st ' ! 5 lines 

parameter  (max_bit  = plt$max_bit) 


equivalence 
equi  v=>lince 
equivalence 
equi valence 
equivalence 
equi valence 
equivalence 
equ i valence 


( bi t_values( pi t$v_au to he) , autohc) 

( bi t_values( pi t$v_v t240 ) , vt240) 

(bi t_values( pi t$v_xscale) , manualx) 
(bi t_vaiues( pi t$v_y scale) , manualy) 

( bi t_values( pi t$v_nosym) , no_sym) 

( bi t_values( pi t$v_ro tate) , rotate) 
(bi t_values(plt$v_scatter ) , scatter) 
(bi  t_values(pltf-v_laser ) , laser) 


Test  for  reasonable  input 


do  i = 1,  ncurv 

if(npts(i)  .It.  0)  then 

status  = pu tmsg(%val ( pi t$_negnump ts) , %val(l),  %val(i)) 
if (.not.  status)  call  1 i b$si gnal (%val ( status) ) 
return 
endi  f 
end  do 


Parse  the  option  bits 

status  = parse_bi t_f lags( 4 , flags,  max_bi t , bit_values) 
if (.not.  status)  call  1 i b$si gnal (%val ( unexperr ) , Jival(l), 
& 'OVERLAY',  Jival (status)) 

axes_flags  = flags  .and.  axes_mask 

Get  the  axes  ranges,  and,  if  manual  scaling  specifed, 
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offer  the  user  the  scaling  choice. 


xmin  = x ( 1 , 1 ) 
xmax  = x(l,l) 
ymin  = y(l,l) 
yrnax  = y(l,l) 
do  n = 1,  ncurv 
do  m = 1 , npts(n) 
if (x(m,n)  .It . 
if (x(m,n)  .gt . 
i f ( y ( m , n ) .It. 
if(y(m,n)  .gt. 
end  do 
end  do 


xmin ) 
xmax ) 
ymin) 
yrnax ) 


xmin 

xmax 

ymin 

yrnax 


x ( m , n ) 
x (m , n ) 
y ( m , ri ) 
y(m,n) 


if(manualx)  then  ! manual  scaling  X 

sxmin  = dsplay$xrnin 
sxmax  = dsplay$xrnax 
incx  = dsplay$incx 

else  < 

call  seal (xmin,  xmax,  sxmin,  sxmax,  incx) 
endi  f 


if(manualy)  then  ! manual  scaling  Y 

symin  = dspiay$ymin 
syrnax  = dsplay$yrnax 
incy  = dsplay^incy 
else 

call  seal (ymin,  yrnax,  symin,  syrnax,  incy) 
endi  f 

if (incx  .eq.  0 .or.  incy  . eq . 0)  goto  50 
if(.not.  laser)  then 

call  qu i et_plo t ( ' on ' ) ! set  terminal  /NOBROADCAST 

if(vt24G  .and.  autohe)  then 
if(rotate)  then 

status  = 1 i b$pu t_screen ( esc  //  '[?47h/) 
else 

status  = 1 i bf-pu  t_screen  ( esc  //  '[?471') 
endi  f 

if  (.not.  status)  call  1 i b$si  gnaJ.  (%o  al  ( pi  t$_unexperr  ) , 'iyal(l), 

& ' OVERLAY''  , %val  ( status)  ) 

endi  f 

if(vt240)  call  v t200_set_mode( 4)  ! TEK  emulation 

endi  f 

if(first)  then 

call  i n i t t ( baudq ( )/10 ) ! In  chars/sec 

first  = .false, 
el sei f ( laser ) then 
call  f f_laser_plo t 
else 

call  newpag  ! clear  screen 

endi  f 


call  dsp_wpage( 16 . , 14.,  8.,  8.) 


Physical  window 
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call  axesl  ( sxmi  n , sxmax  , i ncx , symin  , symax  , i ncy , axes_f  lags) 
1 1 tl  = lien ( t tl ) 
lx  = llen(xlabl) 
ly  = llen(ylabl) 

call  mtitleCttl,  lttl,  xlabl,  lx,  ylabl,  ly) 
j sym  = 0 

call  n_curve(x,  y,  npts,  ncurv,  rnaxpts,  jsym) 
if (.not.  laser)  then 
if(autohc)  then 

call  hard_copy  ! Hardcopy 

endif 


if(vt240)  then 

call  v t2CiO_set__mode( 5)  ! Back  to  VT240 

if(autohc)  call  har d_copy_f f ! ff  printer  if  nef  a:sary 

call  recolor  ! change  ut24Q  col>  back 

endif 

if(rotate)  then 

status  = 1 i b$pu t_screen ( esc  //  '[?471') 

if(.not.  status)  call  lib$signal(%val(plf$_unexperr  .j  , Jival(l), 
'OVERLAY',  »val< status)) 
endif 
endif 

if(.not.  laser)  call  qu i et_plo t ( ' of f ' ) 


return 

end 


/ 

SUBROUTINE  NCKNEW  (NECK) 
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NCKNEW . FOR 

7/12/83.  J.B.  MATRIX  'F'  IS  CORRECTED/12  CHANGES  • 


VRBLS()=LIST  OF  VARIABLES'  NAMES 
FI LNM=FI LE  NAME 
NAMTMP( ) =RUN  NUMBER 

NP()=NUMBER  OF  POINTS  OF  OBSERVATIONS 
NERROR=AN  ERROR  INDICATOR 

RECNM()=THE  RECORD  NUBER  IN  SCRATCH  FILE  SCRTCH.DAT 
TYPEO=ERROR  TYPE 

RECLN=LENGTH  OF  A RECORD  (NUMBER  OF  WORDS) 

DATA  RECLN/801/=RECORD  LENGTH 
NVAR=N UMBER  OF  VARIABLES 
NAME ( NVAR ) “THE  VARIABLE'S  NAME 
RUN(NVAR) -RUN  NUMBER 

MAX ( NVAR )=THE  MAXIMUM  OF  THAT  VARIABLE 

MIN(NVAR) =THE  MINIMUM  OF  THAT  VARIABLE 

UN I TS ( NVAR ) =A  UNIT  OF  MEASUREMENT 

NUMB ( NVAR ) =N UMBER  OF  POINTS  OF  OBSERVATIOMS 

NUM=NP(MAX  I NDEX ) =N UMBER  OF  POINTS  OF  OBSERVATIONS 

BYTE  UNITS(IOO) 

INTEGER*2  NUMB (100) 

INTEGER  RECLEN ,MREC ,NP( 13) ,NERROR , RECNMC 13) ,TYPE(2) 

REAL  DAXS0P( 600 ) .DAYSOP (600) , DAZSOP (600) , DNXSOP (600) , 

& DNYSOPC 600 ) ,DNZSOP(600) ,PHAOXP(600) ,PHB02P*  600) ,PHC03P(600) , 
& PNAOXP( 600 ) , PNB02P( 600 ) ,PNC03P(600) ,TARRY(600) ,MAX(100) , 

& MIN(IQO) 

CHARACTER*6  NAME (100) ,RUN(100) ,VRBLS(13) , F I LNM , NAMTMP 

COMMON  /INDATA/  DAXSOP , DAYSOP , DAZSOP , DNXSOP , DNYSOP , DNZSOP , 

& PHAOXP , PHB02P , PHC03P , PNAOXP , PNB02P , PNC03P , TARRY 

PARAMETER  (MREC=101) 

PARAMETER  (RECLEN=593) 

DATA  VRBLS/ ' DAXSOP ' , ' DAYSOP ' , ' DAZSOP ' , ' DNXSOP ' , ' DNYSOP ' , • 

& ' DNZSOP' , ' PHAOXP' , ' PHB02P' , ' PHC03P' , ' PNAOXP' , ' PNB02P' , 

& 'PNC03P' , 'TIME'/ 

DATA  TY  P E/  ' 0 P EN  ' , ' R E A D ' / 


STEP  Is  OPEN  INPUT  FILE 


OPEN( UN I T =1 , F I LE= ' SCRTCH ' , STATUS= ' OLD ' . RECL-RECLEN , ERR=959 , 
& FORM* ' UNFORMATTED ' , ORGAN I ZAT I ON= ' RELAT I VE ' , I OSTAT  = I OS , 

& ACCESS*' D I RECT' ) 


STEP  2:  READ  IN  DIRECTORY 
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P r-*  IM  (O 


READ ( 1 , REC=1 ) NVAR , NAME , RUN , MAX , M I N , UN I TS , NUMB 


STEP  3:  TEST  FOR  EXI STANCE  OF  VARIABLES 


DO  1 1=1,13 
DO  2 N=1 ,NVAR 

IF(NAMECN) .NE.VRBLS(I))GO  TO  3 
NP( I )=NUMB(N) 

RECNMC I )=N+1 
GO  TO  1 

IF(N.EQ.NVAR)GO  TO  900 
CONTINUE 
CONTINUE 


STEP  4s  READ  APPROPRIATE  RECORD 


READ( 1 , REC=RECNM( 1 ) ) ( DAXSOPC  K) , K=1 ,NP( 1 ) ) 
READ ( 1 , REC=RECNM( 2) ) (DAYSOP(K) ,K=1,NP(2) ) 
READ(l,REC=REOJM(3)) (DAZSOP(K) ,K=1 ,NP(3) ) 
READ ( 1 , REC=RECNM( 4) ) (DNXSOP(K) ,K=1,NP(4) ) 
READ(1 ,REC=RECNM(5) )(DNYSOP(K) ,K=1 ,NP(5) ) 
READ(1 ,REC=RECNM(6) ) (DNZSOP(K) ,K=1 ,NP(6) ) 
READ(1 , REC=RECNM( 7) ) (PHAOXP(K) ,K=1 ,NP(7) ) 
READC1 , REC=RECNM( 8) ) ( PHB02PC  K) ,K=1,NP(8) ) 
READC1 ,REC=RECNM(9) ) (PHC03P(K) ,K=1 ,NP(9) ) 
READd , REC=RECNM(10 ) ) ( PNAOXPC  K) ,K=1 ,NP(10) ) 
READd  , REC=RECNM(11 ) ) ( PNB02P( K)  , K=1  ,NP(11 ) ) 
READd ,REC=RECNMC12))(PNC03P(K) ,K=1,NP(12) ) 
READd  , REC=RECNM(  13)  ) (TARRY ( K)  ,|^=lfNPd3) ) 

CONTINUE 
NERR0R*0 
NUM=NP( 13) 


NAMTMP=RUN(  RECNMd  ) -1 ) 

CALL  NECKTP(NUM ,NERROR .NAMTMP) 

I F (NERROR .NE . 0 ) GO  TO  999 
GO  TO  1000 


ERROR  MESSAGES 

900  NR I TEC  6,901 )VRBLS( I ) 

901  FORMAT ( IX , 'VAR I ABLE x , IX , A10 , IX , ' I S NOT  IN  THE  INPUT  FILE' ,/ , 
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+ IX, "YOU  ARE  ABOUT  TO  BE  RETURNED  TO  MONITOR  LEVEL  TO  ' ,/ , 

+ 1 X , ' T R Y AN  D RECTI FY  THE  PROBLEM', /// ) 


GO  TO  1000 


?99  WR I TEC  £ , 902) TYPE ( NERROR ) 

?0 2 FORMAT ( IX ,A5, ' ERROR  ENCOUNTERED ' / , 

+ IX  , ' PROG  RAM  HALT  , /// ) 

L000  CONTINUE 

CLOSE ( UNIT=1 ) 

END 


SUBROUT I NE  NECKTP < NUM , NERROR , RUNTMP ) 

4TH  EDITION  OF  2/22/83 

FILE:  NECKTP4 . FOR 

COMPUTATION  OF  NECK  STRETCH  T1  TO  OCCIPITAL  CONDYLES 
FROM  PHOTOGRAPHIC  DATA 

GLOSSARY 

PROGRAM  CONSTANTS 


RGAX  = THE  COMPONENT  OF  LINEAR  POSITION  OF  THE 
HEAD  CENTER  OF  GRAVITY  ALONG  THE  X-AXIS 
OF  THE  HEAD  ANATOMICAL  COORDINATE  SYSTEM. 

RGAZ  = SAME  AS  ABOVE  EXCEPT  FOR  THE  Z-AXIS. 

RGOX  = THE  COMPONENT  OF  LINEAR  POSITION  OF  THE 

HEAD  CENTER  OF  GRAVITY  ALONG  THE  X-AXIS  OF  THE 
HEAD  ANATOMICAL  COORD.  SYSTEM  MEASURED  FROM 
THE  OUTSIDE  CONDYLES. 

RGOZ  = SAME  AS  ABOVE  EXCEPT  FOR  THE  Z-AXIS. 

PROGRAM  VARIABLES  (ARRAYS) 


DAXSOP  = X-COMPONENT  OF  DISPLACEMENT  OF  HEAD  A.O. 
(THE  SLED  COORDINATE  SYETEM)  FROM 
PHOTOGRAPHIC  DATA 

DAYSOP  = SAME  AS  ABOVE  EXCEPT  FOR  THE  Y-COMPONENT 

DAZSOP  = SAME  AS  ABOVE  EXCEPT  FOR  THE  Z-COMPONENT 

DNXSOP  = X-COMPONENT  OF  DISPLACEMENT  OF  THE  T1 
A.O.  (THE  SLED  COORDINATE  SYSTEM)  FROM 
PHOTOGRAPHIC  DATA 

DNYSOP  = SAME  AS  ABOVE  EXCEPT  FOR  THE  Y-COMPONENT 

DNZSOP  = SAME  AS  ABOVE  EXCEPT  FOR  THE  Z-COMPONENT 

PHAOXP  = HEAD  ROTATION  ABOUT  X AXIS  (THE  ANATOMIC 
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COORD.  SYSTEM)  FROM  PHOTOGRAPHIC  DATA 
PHB02P  = SAME  AS  ABOUE  EXCEPT  FOR  THE  Y-COMPONENT 

PHC03P  = SAME  AS  ABOUE  EXCEPT  FOR  THE  Z-COMPONENT 

PNAOXP  = ANGLE  OF  ROTATION  OF  T1  ABOUT  X AXIS  OF  THE  T1 
ANATOMICAL  COORD.  SYSTEM  AS  DERIUED  FROM 
PHOTOGRAPHIC  DATA 

PNB02P  = SAME  AS  ABOUE  EXCEPT  ABOUT  THE  CARRIED  Y AXIS 

PNC03P  = SAME  AS  ABOUE  EXCEPT  ABOUT  THE  CARRIED  Z AXIS 

TOXLP/TOYLP/TOZLP=OUTPUT  UARIABLES  GENERATED  BY 

PROGRAM  TRQPHO . FOR  : 

THE  COMPONENT  OF  THE  MOMENT  APPLIED  BY  THE 
NECK  TO  THE  HEAD  ABOUT  AN  AXIS  PARALLEL 
TO  THE  LABORATORY  X/Y/Z-AXIS  AND  PASSING 
THROUGH  THE  ORIGIN  OF  THE  OCCIPITAL  COORD. 
SYSTEM. 

FOXLP/FOYLP/FOZLP=  OUTPUT  UARIABLES  FROM  PROGRAM 

TRQPHO. FOR: 

THE  COMPONENT  OF  FORCE  APPLIED  BY  THE  NECK 
TO  THE  HEAD  PARALLEL  TO  THE  LABORATORY 
X/Y/Z-AXIS  AND  PASSING  THROUGH  THE  ORIGIN 
OF  THE  OCCIPITAL  COORD.  SYSTEM. 


OUTPUT  UARIABLES 


RATIXP 


RATI YP 
RATIZP 
ROTIXP 


ROTIYP 
ROTIZP 
RAT  IP 


ROT  IP 


TENTYP 


X - C OM P ON ENT  OF  POSITION  OF  THE  HEAD  ANATOMICAL 
ORIGIN  WITH  RESPECT  TO  THE  T1  ANATOMICAL  ORIGIN 
THE  LABORATORY  COORD.  SYSTEM)  FROM  PHOTOGRAPHIC  ' 
DATA 

SAME  AS  ABOUE  EXCEPT  FOR  THE  Y-COMPONENT 

SAME  AS  ABOUE  EXCEPT  FOR  THE  Z-COMPONENT 

X-COMPONENT  OF  POSITION  OF  THE  OCCIPITAL 
CONDYLE  WITH  RESPECT  TO  THE  T1  ANATOMIC 
ORIGIN  (THE  LABORATORY  COORD.  SYSTEM)  FDCM 
PHOTOGRAPHIC  DATA 

: SAME  AS  ABOUE  EXCEPT  FOR  THE  Y-COMPONENT 

SAME  AS  ABOUE  EXCEPT  FOR  THE  Z-COMPONENT 

THE  DISTANCE  FROM  THE  HEAD  ANATOMICAL 
ORIGIN  TO  THE  T1  ANATOM I Chl  ORIGIN 
FROM  PHOTOGRAPHIC  DATA 
THE  DISTANCE  FROM  THE  OCCIPITAL 
CONDYLE  TO  THE  T1  ANATOMICAL  ORIGIN 
FROM  PHOTOGRAPHIC  DATA 

: THE  ANGLE  OF  ROTATION  OF  A PLANE  FORMED  B'r  THE 
Y AXIS  OF  THE  T1  ANATOMICAL  COORD.  SYSTEM  AND 
THE  U ECTOR  JOINING  T'l  WITH  THE 

OCCIPITAL  CONDYLE  WITH  RESPECT  TO  THE  PLANE  FORMED 


BY  THE  Y AND  Z AXES  OF  THE  T1  ANATOMICAL  COORD. 
SYSTEM  AS  DERIUED  FROM  PHOTOGRAPHIC  DATA 
TENTXP  = THE  ANGLE  OF  ROTATION  OF  A PLANE  FORMED  BY  THE 

X AXIS  OF  THE  T1  ANATOMICAL  COORD.  SYSTEM  AND  THE 
U ECTOR  JOINING  T1  WITH  RESPECT  TO  THE  PLANE  FORMED 
BY  THE  X AND  Z AXES  OF  THE  T1  ANATOMICAL  COORD. 
SYSTEM  AS  DERIUED  FROM  PHOTOGRAPHIC  DATA 
TETHNC=THE  ANGLE  OF  ROTATION  OF  A PLANE  FORMED  BY  THE 
X-AXIS  OF  THE  HEAD  ANATOMICAL  ORIGIN  AND 
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THE  2-AXIS  OF  THE  NECK  CHORD  LINE  COORDINATE  SYSTEM 
NITH  RESPECT  TO  THE  PLANE  FORMED  BY  THE  X- 
AND  Z-AXES  OF  THE  NECK  LINE  COORDINATE  SYSTEM 
TOXOP  = THE  COMPONENT  OF  TORQUE  APPLIED  BY  THE  NECK  TO  THE 
HEAD  AT  THE  OCCIPITAL  CONDYLES  ALONG  THE  X-AXIS 
OF  THE  NECK  CHORD  COORDINATE  SYSTEM 
TOY OP  = THE  COMPONENT  OF  TORQUE  APPLIED  BY  THE  NECK 

TO  THE  HEAD  AT  THE  GCCI-PITAL  CONDYLES  ALONG  THE- 
AXIS  OF  THE  NECK  CHORTD  COORDINATE  SYSTEM 
TOZOP  = THE  COMPONENT  OF  TORQUE  APPLIED  BY  THE  NECK  TO 

THE  HEAD  AT  THE  OCCIPITAL  CONDYLES  ALONG  THE  2 -AXIS 
OF  THE  NECK  CHORD  COORDINATE  SYSTEM 
FOX OP  = THE  COMPONENT  OF  FORCE  APPLIED  BY  THE  NECK  TO  THE 
HEAD  AT  THE  OCCIPITAL  CONDYLES  ALONG  THE  X-AXIS 
OF  THE  NECK  CHORD  COORDINATE  SYSTEM 
FOYOP  = THE  COMPONENT  OF  FORCE  APPLIED  BY  THE  NECK  TO  THE 
HEAD  AT  THE  OCCIPITAL  CONDYLES  ALONG  THE  Y-AXIS 
OF  THE  NECK  CHORD  COORDINATE  SYSTEM 
F020P  = THE  .COMPONENT  OF  FORCE  APPLIED  BY  THE  NECK  TO  THE 
HEAD  AT  THE  OCCIPITAL  CONDYLES  ALONG  THE  Z-AXIS 
OF  THE  NECK  CHORD  COORD.  SYSTEM 

T1XLP=  THE  COMPONENT  OF  TORQUE  APPLIED  BY  THE  TORSO  TO  THE  NECK 
AT  THE  T1  VERTEBRA  ALONG  THE  X-AXIS  OF  THE  LABORATORY 
COORDINATE  SYSTEM. 

T1YLP=  THE  COMPONENT  OF  TORQUE  APPLIED  BY  THE  TORSO  TO  THE  NECK 
AT  THE  T1  VERTEBRA  ALONG  THE  Y-AXIS  OF  THE  LABORATORY 
COORDINATE  SYSTEM. 

T1ZLP=  THE  COMPONENT  OF  TORQUE  APPLIED  BY  THE  TORSO  TO  THE  NECK 
AT  THE  T1  VERTEBRA  ALONG  THE  2-AXIS  OF  THE  LABORATAORY 
COORDINATE  SYSTEM. 

REAL  TOXLP( 600 ) ,TOYLP(600) ,TOZLP(600) ,FOXLP(600) ,FOYLP(600) , 

& FOZLPC600) ,TOXOP( 600 ) ,TOYOP(600) ,TOZOP(600) ,FQXOP(60G) , 

& FOYOP( 600 ) , FOZOP( 600 ) ,TETHNP(600) ,PSI(600) ,RATIXP(600) , 

& RATI YP( 600 ) , RATIZP( 600 ) ,ROTIXP(600) , ROTIYP( 600 ) , ROTIZPC 600 ) , 

& RATI P( 600 ) , ROT I P( 600 ) ,TENTYP(600) ,TENTXP( 600 ) ,T1XLP( 600 ) , 

& T1YLP( 600 ) ,T1ZLP( 600 ) ,T1XTP(600) ,T1YTP<600) ,T1ZTP(600) 
CHARACTERS  NAMTMP ( 24 ) , RUNTMP 
INTEGER  NERROR 
INCLUDE  ' COMP . FOR' 

TRANSFER  OF  DATA  FROM  TRQPHO . FOR  PROGRAM 


DATA  NAMTMP/ ' RAT I XP ' , 'RATIYP' , 'RATIZP' ,'ROTIXP' , 'ROTIYP' , 
& ' ROTIZP'  , 'RATIP'  , ' ROT  I P'  , /TENTY’P/  ,'TENTXP'  , 'TETHNP'  , 

& 'PSI'  , 'TOXOP'  ,'TOYOP^  , ''TOZOP''  ,'FOXOP'  FOYOP"  ,"FOZOP"  , 

& "T1XLP" , "T1YLP" , "T1ZLP" , "T1XTP" , 'T1YTP' , "T1ZTP"/ 

C SUBJECT  NUMBER  SELECTION 

1700  CONTINUE 

READ( 5 ,*)NJCT 
NRITE( 6 , 1755)NJCT 

1755  FORMAT ( 5X , " SUBJECT  NUMBER3' ,15) 

I F (NJCT . EQ . 1 ) GO  TO  1001 
I F'(NJCT  . EQ  . 44)  GOTO  1044 
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I F (NJCT . EQ . 64) GOTO  1064 
I F (NJCT . EQ . 65) GOTO  1065 
IF(NJCT.EQ. 67) GOTO  1067 
I F (NJCT . EQ . 83) GO  TO  1083 
I F(NJCT . EQ . 93) GO  TO  1093 
I F(NJCT . EQ . 96) GO  TO  1096 
I F (NJCT . EQ . 118) GO  TO  1118 
I F(NJCT . EQ . 120 ) GO  TO  1120 
I F(NJCT . EQ . 127) GO  TO  1127 
I F(NJCT . EQ . 130 ) GO  TO  1130 
I F(NJCT . EQ . 131 ) GO  TO  1131 
I F(NJCT . EQ . 132) GO  TO  1132 
I F (NJCT . EQ . 133) GO  TO  1133 
I F ( NJCT . EQ . 1 34 ) GO  TO  1134 
I F(NJCT . EQ . 135) GO  TO  1135 

I F (NJCT . EQ . 136) GO  TO  1136 

I F (NJCT . EQ . 138) GO  TO  1138 

I F(NJCT . EQ .139) GO  TO  1139 

I F (NJCT . EQ .140 ) GO  TO  1140 

I F (NJCT . EQ . 141 ) GO  TO  1141 

I F(NJCT . EQ . 142) GO  TO  1142 

1701  CONTINUE 
WRITE( 6,1702) 

1702  FORMAT ( IX , ' INCORRECT  SUBJECT  NUMBER') 

STOP 

1001  CONTINUE 

RGAX=0 .012 
RGAZ=0 .029 
RGOX=0 .0234 
RGOZ-O .055 
ARP=0 .0 
BR=0 . 0 
DNZMN=0 . 0 
XCR=0 . 0 
YCR=0 . 

ZCR=0 . 0 
GO  TO  999 

C 

1044  CONTINUE 

C 

RGAX=Q .012 
RGAZ=0 .029 
RGOX=0 .023 
RG0Z=0 .055 
AP.P=1 .160 
BR=-0 .492 
DNZMN=1 .091 
XCR=0 . 0 
YCR=0 . 0 
ZCR=0 .0 
GO  TO  999 

C 

1064  CONTINUE 

C 


RGAX=0 .012 


o 


RGAZ=G .029 
RGGX=0 .023 
R60Z=0 .055 
ARF-1 .146 
BR=-0 .294 
DNZMN=1 .091 
CR=G  . 

Y CR=0 . 0 
ZCR=0  .0 
GO  TO  999 
065  CONTINUE 

RGAX=0 .012 
RGAZ=0 .029 
RGOX=0 .023 
RGOZ=0 .055 
ARP=1 .154 
BR=-0 .410 
DNZMN=1 .095 
XCR-0 . 

YCR*0 .0 
ZCR=0 .0 
GO  TO  999 
1067  CONTINUE 
C 

RGAX=0 .012 
RGAZ=0 .029 
RGOX=0 .023 
RG02=0 .055 
ARP=1 .059 
BR=-*0 .0719 
DNZMN=1 .047 
XCRs0 . 0 
YCR=0 .0 
ZCR=0 .0 
GO  TO  999 
C 

1083  CONTINUE 
C 

RGAX=Q .012 
RGAZ=Q .029 
RGOX=0 .023 
RGOZ=0 .055 
ARP=1 .272224 
BR-“1 . 31925 
DNZMN=1 .128304 
XCR=Q .0 
YCR=0 .0 
ZCR=0 .0 
60  TO  999 
C 

1093  CONTINUE 

RGAX=0 .012 
RGAZ=0 .029 
RGOX=0 .023 
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c 

1096 


1118 


1120 


] 

j 

1127 

i 


1130 


RG0Z=O .055 
ARP=1 .239763 
BR=-0 .941244 
DNZMN=1 .098385 
XCR=0 .0 
YCR=0 . 

ZCR=0 . 

GO  TO  999 

CONTINUE 
RGAX=0 .012 
RGAZ=0 .029 
RGOX=0 .023 
RGOZ=0 .055 
GO  TO  999 
CONTINUE 
RGAX= .012 
RGAZ= .029 
RGOX= .023 
RGOZ= . 055 
ARP=1 .472471 
BR=-. 537460 
DNZMN=1 .380167 
XCR=Q . 

YCR=0 . 

ZCR=0 . 

GO  TO  999 
CONTINUE 
RGAX= .012 
RGAZ= . 0 29 
RGOX= . 023 
RGOZ= .055 
ARP=1 .554563 
BR=-1 .00074 
DNZMN=1 .383071 
XCR=0 . 

YCP.=0  . 

ZCR=0 . 

GO  TO  999 
CONTINUE 
RGAX= .012 
R GAZ  = . 029 
RGOX= .023 
RGOZ= . 055 
ARP=1 .541470 
BR=-. 976451 
DNZMN=1 .382870 
XCR=Q . 

YCR=0 . 

ZCR=0 . 

GO  TO  999 
CONTINUE 
RGAX= .012 
RGAZ- . 029 
RGOX= .023 
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RGOZ= . 0 55 
ARP=1 .665381 
BR=-1 . 48835 
DNZMN=1 . 396358 
XCR=0 . 

YCR-0 . 

ZCR=0 . 

GO  TO  399 

1131  CONTINUE 
RGAX= .012 
RGAZ= .029 
RGOX= .023 
RGOZ= . 055 
ARP=1 . 520460 
BRa-0 .753537 
DNZMN=1 .402846 
X‘CR=0  . 

YCR=0 . 

ZCR=0 . 

GO  TO  999 

1132  CONTINUE 
RGAX= .012 
RGAZ=0 .029 
RGOX= . 023 
RGOZ= » 055 
ARP=1. 523568 
BR=-0. 927588 
DNZMN=1 . 392558 
XCR-0 . 

YCR=0 . 

ZCR=0 . 

GO  TO  999 

1133  CONTINUE 
R6AX- a 012 
RGAZ= . 029 
RGOX= .023 
RGOZ= . 055 
ARP=1 .513768 
BR=»0 .751378 
DNZMN=1 .389440 
XCR-0 . 

YCR-0 . 

ZCR=0 . 

GO  TO  999 

1134  CONTINUE 
RGAX= .012 
RGAZ= . 029 
RGOX= .023 
RGOZ= . 055 
ARP=1 .543767 
BR=-0 . 862035 
DNZMN=1 .40791 
XCR=0 . 

YCR=0 . 

ZCR=0 . 
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GO  TO  939 

1135  CONTINUE 
RGAX= .012 
RGAZ= . 0 29 
RGOX=. 023 
RG02= .055 
ARP=1 .552383 
BR=-0 .962941 
DNZMN=1 .408047 
XCR=Q . 

YCR=0 . 

ZCR=0 . 

GO  TO  999 

1136  CONTINUE 
RGAX= .012 
RGAZ= . 029 
RGOX= . 023 
RGOZ= .055 
ARP=1 .413834 
BR=-0 .130286 
DNZMN=1 .391344 
XCR=0 . 

YCR=0 . 

ZCR=0 . 

GO  TO  399 
1138  CONTINUE 
RGAX= .012 
RGAZ= .023 
RGOX-.023 
RGOZ= .055 
ARP=1 .493554 
BR=-0 .626753 
DNZMN=1 . 384522 
XCR=0. 

YCR=0 . 

ZCR=0 . 

GO  TO  993 
1133  ' CONTINUE 
RGAX= .012 
Ri3AZ= . 0 23 
RGOX= . 023 
RuOZ= .055 
ARP=1 .537038 
BR=-0 .821211 
DNZMN=1 . 401S46 
XCR=0 . 

YCR=0 . 

ZCR=0 . 

GO  TO  939 
1140  CONTINUE 
RGAX= .012 
RGAZ= . 029 
RGOX= . 023 
RGOZ= .055 
ARP=1 .515952 


BR*-0 .732621 
DNZMN='l  .388380 
XCR  = 0 . 

Y CR=0 . 

ZCF.=0  . 

GO  TO  399 

1141  CONTINUE 
RGAX=G  .012 
RGAZ  = . 029 
R.GOX=  .023 
RGOZ= . 055 
ARP=1 .542182 
BR=-0. 785473 
DNZMN=1 .403853 
XCR=0 . 

YCR=0 . 

ZCR=0 . 

GO  TO  333 

1142  CONTINUE 
R6AX= .012 
RGAZ= .029 
RGOX- . 0 23 
RGOZ= . 055 
ARP=1 . 55860  5 
BR=-0. 987192 
DNZMN=1 .399655 
XCR-0 . 

YCR=0 . 

ZCR=0 . 

GO  TO  999 
C 

1725  CONTINUE 

999  CONTINUE 

DELT=0 .0005 

! TPMAX=TARRY(NUM) 

TSMAX=DELT*598 

! I F (TPMAX . LE .TSMAX) GO  TO  55 

! print  *,'here  I am" 

DO  11  K=1,NUM 
K1=K 

TAR=TARRY ( K1 ) 

I F(TAR . LE .TSMAX) GO  TO  11 
KC=K 

KMAX=KC-1 
GO  TO  22 
C 

11  CONTINUE 

22  CONTINUE 

C 

! print  */kmax=/  ,kma;< 

NUM=KMAX 

C.  OPEN  INPUT  FILENNN.DAT 

C 

OPEN(  UNIT=10  , FI  LE='NNN"  ,ACCESS='  SEQUENTIAL"  , STATUS3'-  OLD  '' ) 
DO  1212  K=1,NUM 
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J=K 

READdO  , 1220  )TOXLP(  J)  ,TQYLP( J)  ,TOZLP( J)  , 

+ FOXLPC J) ,FOYLP( J) ,FOZLP(  J) 

C wr i te( 6 , 1220 ) toxlp ( j ) 

1220  FORMAT ( 6( E13 . 7) ) 

1212  CONTINUE 

CLOSE ( UNIT=10 ) 

C 

55  CONTINUE 

C EQUATIONS  (2) 

C kkkkkkkkkkkirk-k 

ROAXA=RGAX-RQOX 

ROAZA=RGAZ-RGOZ 

C 

C MATRIX  P 

C 

TET1X0=PNA0XP(1) 

TET1Y0=PNB02P( 1 ) 

TET1Z0=PNC03P( 1 ) 

C 

P11=C0S(TET1Z0)*C0S(TET1Y0) 

P211=C0S(TET1X0)*SIN(TET1Z0) 

P212=C0S(TET1Z0)*SIN(TET1Y0)*SIN(TET1X0) 

P21=P211+P212 

P311=SIN<TET1Z0)*SIN(TET1X0) 

P312=-C0S(TET1Z0)*SIN(TET1Y0)*C0S(TET1X0) 

P31=P311+P312 

C ' * 

P12=-SIN(TET1Z0)*C0S(TET1Y0) 

P221=C0S(TET1Z0)*C0SCTET1X0) 

P222=-SIN(TET1Z0)*SIN(TET1Y0)*SIN(TET1X0) 

P22=P221+P222 

P321=C0S(TET1Z0)*SIN(TET1X0) 

P322=SIN(TET1Z0)*SIN(TET1YQ)*C0S(TET1X0> 

P32=P321+P322 

C 

P13=SIN(TET1YQ) 

P23=-C0S  C TET1YO ) *SIN( TET1XO ) 
P33=C0S(TET1Y0)*C0S(TET1X0) 

C 

1=0 

10  CONTINUE 

1=1+1 

I F( I . EQ .NUM) GO  TO  100 
TETAX=PHAOXP( I ) 

TETAY=PHB02P( I ) 

TET*AZ=PHC03P  ( I ) 

C 

C EQUATIONS  (3)  — TRANSFORMATION  OF  OCCIPITAL 

C CONDYLE  LOCATION  RELATIVE  TO  ANATOMICAL  ORIGIN  IN 

C THE  ANATOMICAL  COORDINATE  SYSTEM  TO  COMPONENTS  IN 

C IN  THE  LABORATORY  COORD.  SYST . 

C kkk-k-k-k-kkk-kk-k-kkk-kkkkk-kk-kk-kirk-k-k-k 

All=ROAXA*COS(TETAZ)*COS(TETAY> 
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A 1 2 = R GAZA*  S I N ( T ET AY ) 

R0AXP=A1 1+A1 2 

A 2 1 = R OAXA* C 0 S ( T ET AX ) * S I N ( T ET A2 ) 

A 2 2 = R OAXA*  C 0 S ( T ET  AZ  > * S I N ( T ET  A Y ) * S I N < T ET  AX  ) 

A 2 3 = - R OAZ A* C 0 S ( T ET AY )*SI N ( T ETAX ) 

R 0 A Y P = A 2 1 +A  2 2+ A 2 3 

A31 =ROAXA*S I N ( TETAZ )*SIN( TETAX ) 
A32=-R0AXA*C0S ( TETAZ ) *3 I N ( TETAY ) *COS ( TETAX ) 
A33=RQAZA*CQS ( TETAY )*CGS (TETAX  > 

R OAZ  P = A 3 1 + A 3 2+ A 3 3 
C 

RAXP=DAXSOP( I ) 

RAY  P=  DAY  SO  Pi.  I ) 

R AZ  P = D AZ  S 0 P ( I > 

RT I XP=DNXSOP ( I ) 

RTI YP=DNYSOP( I ) 

RT IZP=DNZ30P ( I ) 

C 

C EQUATIONS  (6) 

C •k-k'k-k-k'kirirk’kirirk 

c. 

B1=RAXP-RTIXP 
B2=RAYP-RTI YP 
B3=RAZP-RTIZP 
RATIXP(I)=B1 
RATI YP( I ) =B2 
RATIZPCI )=B3 

RAT I P ( I )=SQRT(B1**2+B2**2+B3**2) 

I F ( i . GT . 1 ) GO  TO  200 
YP=ARP+BR*RATI P( 1 ) 

DL2=YP-DNZMN 
200  CONTINUE 

B1P=B1+XCR 

B2P=B2+YCR 

B3P=B3+DL2+ZCR 

RATI P( I ) =SQRT ( B1P**2+B2P**2+B3P**2) 

C 

C EQUATIONS  (7) 

C 

Cl -B1 P+ROAXP 
C2=B2P+R0AYP 
C3=B3P+R0AZP 
ROTIXPC I ) =C1 
ROTIYPC I )=C2 
ROTIZPC I )=C3 

ROT I P( I )=SQRT(C1**2+C2tHc2+C3**2) 

1899  CONTINUE  ! TEMPORARY  TO  1901 

I F ( ROT I P ( I ) . LT . 0 . 25 ) GO  TO  1901 
RAT  I P ( I ) =0  . 

! ROT I P( I ) =0 . 

WRITEC 6,1900) 

1900  FORMAT ( IX, "MISSING  PHOTO  DATA?' ) 

1901  CONTINUE 

C EQUATIONS  (9) 

C rtrkirkirkirkicicificir 
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TETA1X=PNA0XP( I ) 

TETA1Y=PNB02P( I ) 

TETA1Z=PNC03P( I ) 

PS I ( I ) =1 . 570  8-PHC03P ( I ) 

MATRIX  D 

D11=C0S(TETA1Z)*C0S(TETA1Y) 
D21=-SIN(TETA1Z)*C0S(TETA1Y) 

D31=SIN(TETA1Y) 

' D121=C0S(TETA1X)*SIN(TETA1Z) 

D122=C0S(TETA1Z)*SIN(TETA1Y)*SIN(TETA1X) 
D12=D121+D122 

D221=C0S(TETA1Z)*C0S(TETA1X) 
D222=-SIN(TETA1Z)*SIN(TETA1Y)*SIN(TETA1X) 
D22=D221+D222 

D32=-C0S(TETA1Y)*SIN(TETA1X) 

D131=SIN(TETA1Z)*SIN(TETA1X) 
D132=-C0S(TETA1Z)*SIN(TETA1Y)*CGS(TETA1X) 

D1 3=01 31+D1 32 

0231 =COS ( TETA1Z ) *S I N ( TETA1X ) 
D232=SIN(TETA1Z)*SIN(TETA1Y)*C0S(TETA1X) 
D23=D231+D232 

D33=C0S ( TETA1 Y ) *COS ( TETA1X ) 

EQUATIONS  (10) 

★******j*r******* 

MATRIX  PD=P  X D 

PD11=P11*D11+P12*02i+P13*D31 
PD21=P21*011+P22*D21+P23*D31 
P031*P31*D11+P32*D21+P33*031 

PD1 2=P1 1*01 2+ PI 2*D22+P1 3*032 
PD22=P 21*01 2+P22*D22+P 23*032 
P032=P31*D12+P32*022+P33*D32 

P 0 1 3 = P 1 1 * D 1 3+ P 1 2* D23+P1 3* 0 3 3 
P D 2 3 = P 2 1 * 0 1 3+  P 2 2* 0 2 3+ P 2 3*  D 3 3 
P 0 3 3 = P 3 1 * 0 1 3+  P 3 2 * 0 2 3 + P 3 3 * 0 3 3 

R OTX =P011*C1+P01 2*  C 2+  P 0 1 3* C 3 
R0TY=PD21*C1+PD22*C2+P023*C3 
R OTZ = P 0 3 1 * C 1 + P 0 3 2*  C 2+  P 0 3 3*  C 3 

GAMA=AS I N ( ROTY/ROT I P ( I ) ) 

TENTX=GAMA 

C IF  ROTZ  IS  APPROACHING  ZERO  THEN  ATAN  IS  30  DEGREES 

I F ( ABS ( ROTZ ) . LT . 0 . 0 0 0 0 0 1 ) GO  TO  1 0 0 0 
BETA=ATAN ( R OTX/ ROTZ ) 

I F(  ( P.OTX  . GE  . 0 ) .AND  . ( ROTZ  . GT  . 0 ) )TENTY  = BETA 
I F( ( ROTX . GE . 0 ) .AND . ( ROTZ . LT . 0 ) )TENTY-3 . 14153+BETA 
I F( ( ROTX . LT . 0 ) .AND . ( ROTZ . GT . 0 ) ) TENTY =BETA 
IF< (ROTX.LT.O) .AND. (ROTZ. LT . 0) )TENTY=-( 3 . 14153-BETA) 
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C . GAMA = AT  AN C ROTY/ROTI P( I ) ) 

C * : - a R GT Y . G E . 0 ) . AN  D . ( R GTZ . GT . 0 ) ) T ENTX = GAMA 

C I F ( ( ROTY . GE  . 0 ) . AND . ( ROTZ . LT . 0 ) ) T ENTX =3 . 141 58+ GAM A 

C IFif ROTY . LT . 0 ) . AND . ( ROTZ . GT . 0 ) ) T ENTX = GAMA 

C I F C (ROTY.LT.O) . AND . ( ROTZ . LT . 0 ) )TENTX=-( 3 . 14158-GAMA 

GO  TO  2000 
1000  CONTINUE 

I FC ROTX . GE . 0 ) SI GN1=1 
I F ( ROTX  . LT  . 0 ) SI  GN1=-1 
I F ( ROTY . GE . 0 ) SI GN2=1 
I F ( ROTY . LT . 0 ) S I GN2=-1 
x ENT Y = S I GN 1 + 1 .57 
C TENTX=SIGN2*1 .57 

2000  CONTINUE 

TENTYPC I ) =TENTY 
IFC'I.GT.l)  GO  TO  2001 
T ENT  Y 1 =T  ENT  Y 

2001  TENTYPC I)  = TENTYPC I ) - TENTY1 
T ENTX PC  I ) =TENTX 

EQUATION  C 14) 

•k-k-k-k’k-kiHrk-kjr'k'k 

TET11Y=ASINC  ROTIXPC I )/ROTIPC I ) ) 

EQUATION  C 15) 

T ET 1 1 X = -T  ENTX 
EQUATIONS  C 19) 


MATRIX  RO 

R011=C0SCTET11Y) 

R021=0. 

R031=SINCTET11Y) 

R012=SIN(TET11Y)*SIN(TET11X) 
R022=C0SCTET11X) 
R032=-C0SCTET11Y)*SIN(TET11X) 

R013=-SINCTET11Y)*C0SCTET11X) 
R023=SINCTET11X) 
R033=C0SCTET11Y)*C0S(TET11X) 

MATRIX  ROD  = RO  X D 

R0D11=R011*D11+R012*D21+R013*D31 
R0D21=R021*D11+R022*D21+R023*D31 
R0D31=R031*D11+R032*D21+R033*D31 
C 

R0D12=R011+D12+R012*D22+R013+D32 

R0D22=R021*D12+R022*D22+R023*D32 
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C 


c 


c 


I 


R0D32=R031*D12+R032*D22+R033*D32 

ROD13=R011*D13+R012*D23+R013*D33 

R0D23=R021*D13+R022*D23+R023*033 

R0D33=R031*D13+R032*D23+R033*033 


T0X0=R0D11*T0XLP( I )+R0D12*T0YLP( I )+R0D13*T0ZLP( I ) 
T0Y0=R0D21*T0XLP( I )+R0D22*T0YLP( I )+R0D23*T0ZLP( I ) 
T0Z0=R0D31*T0XLP( I )+R0D32*T0YLP< I )+R0D33*T0ZLP( I ) 

T0X0P( I )=T0X0 
T0Y0P( I ) =T0Y0 
T0Z0P( I ) =T0Z0 


EQUATIONS  (20) 


F0X0=R0D11*F0XLP( I )+R0D12*F0YLP( I )+R0D13*F0ZLP( I ) 
F0Y0=R0D21*F0XLP( I )+R0D22*F0YLP( I )+R0D23*F0ZLP( I ) 
F0Z0=R0D31*F0XLP( I )+R0D32*F0YLP( I )+R0D33*F0ZLP( I ) 


F0X0P( 

F0Y0P( 

F0Z0PC 

T1XLP( 

T1YLP( 

T1ZLPC 

T1XTPC 

TIYTPC 

T1ZTP( 


I ) =F0X0 
I ) =F0Y0 
I ) =F0Z0 

I)  = TOXLP(I)  + ROTIYPC I)*F0ZLP( I ) - R0TIZP( I 
I)=  TOYLP(I)  - R0TIXP( I )*F0ZLP( I ) + ROTIZPCI 
I ) = TOZLP(I)  + ROTIXPC I )*F0YLP( I ) - R0TIYP(I 
I ) = PD11*T1XLP( I )+PD12*TlYLP( I )+PD13*TlZLP( I 
I )=  PD21*T1XLP( I )+PD22*TlYLP( I )+PD23*TlZLP( I 
I )=  P031*T1XLP( I )+PD32*TlYLP( I )+PD33*TlZLP( I 


)*F0YLP( I ) 
)*F0XLP( I ) 
)*F0XLP( I ) 
) 

) 

) 


EQUATIONS  (17) 


MATRIX  R 


R11=C0S(TET11Y) 
R21=0 . 

R31=SIN(TET11Y) 


R1 2=S IN(TETllY) *S I N ( TET1 IX ) 

P.22=C0S(TET11X) 

R32=-C0S( TET11Y ) *S I N ( TET1 IX ) 

R13=-SIN(TET11Y)*C0S(TET11X) 

R23=SIN(TET11X) 

R33=C0S(TET11Y)*C0S(TET11X) 

MATRIX  F 

FI  =C0S(  TETAZ ) *C0S  ( TETAY  )' 

F21 =COS ( TETAX ) *S I N ( TETAZ ) 

F22=C0S ( TETAZ ) *S I N( TETAY ) *S I N( TETAX ) 
F2=F21+F22 

F31 =S I N ( TETAZ ) *S I N ( TETAX ) 

F32=-C0S ( TETAZ ) *S I N ( TETAY ) *C0S ( TETAX ) 
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F3*F31+F32 

C 

C MATRIX  RD=R  X PD 

C 

RD11=R11*PD11+R12*PD21+R13*PD31 

RD21=R21*PD11+R22*PD21+R23*PD31 

RD31=R31*PDll+R32*PD21+R33*PD3i 

C 

RD1 2=R1 1*PD1 2+R1 2+PD22+R1 3*PD32 
RD22=R21*PD12+R22*PD22+R23*PD32 
R D 3 2 = R 3 1 * P D 1 2+  R 3 2*  P D 2 2+  R 3 3*  P D 3 2 

P.  D 1 3= R 1 1 * P D 1 3+  R 1 2*  P D 2 3+  R 1 3*  P D 3 3 
R D 2 3 = R 2 1 * P D 1 3+ R 2 2*  P D 2 3+  R 2 3*  P D 3 3 
R D 3 3 = R 31*P D 1 3+  R 3 2* P D 2 3+  R 3 3* P D 3 3 

E1NCX=RD11*F1+RD12*F2+RD13*F3 

E1NCY=RD21*F1+RD22*F2+RD23*F3 

E1NCZ=RD31*F1+RD32*F2+RD33*F3 

C 

C IF  E1NCX  IS  APPROACHING  ZERO  THEN  AT AN  IS  90  DEGREES 

IF(ABSCEINCX) . LT . 0 .000001) GO  TO  1101 
BETA=ATAN( E1NCY/E1NCX ) 

I F ( < E1NCY . GE . 0 ) . AND . ( E1NCX . GT . 0 ) ) TETHNC=BETA 
I F ( ( E1NCY . GE . 0 ) .AND . C E1NCX . LT . 0 ) )TETHNC=3 . 1415S+BETA 
IF( (E1NCY.LT. 0) .AND. t E1NCX . GT . 0 ) )TETHNC=BETA 
I F( ( E1NCY . LT . 0 ) .AND . ( E1NCX . LT . 0 ) )TETHNC=-( 3 . 14158-BETA) 
GO  TO  2201 
1101  CONTINUE 

I F( E1NCY . GE . 0 ) SI GN1=1 . 

I F( E1NCY . LT . 0 ) SI GN1=-1 . 

TETHNC=SI GN1*1 . 57 
2201  CONTINUE 

C TETHNPC I )=TETHNC  - TETHNP(l) 

C 

C MATRIX  RH  INVERSE 

C 

RHI 1 1 =COS ( TETAZ )*COS( TETAY) 

RHI 12=-S I N( TETAZ )*COS< TETAY) 

RHI13=SIN(TETAY) 

C 

RHI 211-C0S(TETAX)*SIN(TETAZ) 

RH I 21 2=C0S ( TETAZ ) *S I N ( TETAY ) *S I N( TETAX ) 

RHI  21=RHI  211+P.HI  212 

RH I 221 =COS( TETAZ )*COS( TETAX) 
RHI222=-SIN(TETAZ)*SIN(TETAY)*SIN(TETAX) 

RHI 22=RHI 221+RHI 222 

RHI 23=-C0S( TETAY )*S I N( TETAX) 

C 

RH I 31 1 =S I N ( TET AZ ) *S I N ( TET AX ) 

RH I 31 2=-C0S ( TETAZ )*S IN( TETAY )*COSC TETAX) 

RHI 31 =RH I 31 1+RH I 31 2 

RHI 321 =CQS( TETAZ) *SIN( TETAX) 

RH I 322=S I N ( TETAZ ) *S I N ( TETAY ) *COS ( TETAX ) 

RHI 32=RHI 321+RHI 322 
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R H I 3 3 = C 0 S C T ET AY ) * C 0 S < T ETAX ) 

C 

C MATRIX  PD  x RHI 

C 

RIDP11=PD11*RHI11+PD12*RHI21+PD13*RHI31 
RI DP12=PD11*RHI12+PD12*RHI 22+PD13*RHI 32 
RIDP13=PD11*RHU3+PD12*RHI23+PD13*RHI33 
C 

C IF  RIDP11  IS  APPROACHING  ZERO  THEN  ATAN  IS  90  DEGREES 

IF(ABS(RIDP11) .LT.O .000001)  GO  TO  2500 
BETA=ATAN ( R I DPI 2/R I DPI 1 ) 

IF ( (RIDP12. GE . 0 ) .AND. (RIDP11 .GT.O) )PSIP=BETA 
IF( (RIDP12.GE.0) .AND. (RIDPll .LT.O) ) PSI P=3 . 14158+BETA 
I F( ( RI DPI 2 . LT . 0 ) .AND. (RIDPll .GT.O) )PSIP=  BETA 
IF( ( RIDP12.LT. 0) .AND. (RIDPll .LT.O) )PSIP=-( 3. 14158-BETA) 
GO  TO  2600 
2500  CONTINUE 

I F ( R I DPI 2 . GE . 0 ) S I GN1 =1 . 

I F( R I DPI 2 . LT . 0 ) SI GN1=-1 . 

PSIP=SIGN1*1 .57 

2600  CONTINUE 

TETHNPC I )=1 .570S+PSIP 
I F( I . GT . 1 ) GO  TO  2601 
TETHN1 =TETHNP ( 1 ) 

PSI1=PSI (1) 

2601  TETHNPC I ) -TETHNPC I ) -TETHN1 
PSI C I ) =PSI C I ) -PSI 1 

GO  TO  10 
100  CONTINUE 

C 

CALL  F I LEO  C NAMTMP C 7 ) , RUNTMP , 1 , NUM , NERROR , RAT I P ) 

CALL  F I LEO ( NAMTMP ( 8 ) , RUNTMP , 1 , NUM , NERROR , ROT I P ) 

CALL  F I LEO  C NAMTMP ( 9 ) , RUNTMP , 5 , NUM , NERROR , TENTYP ) 

CALL  F I LEO ( NAMTMP (10), RUNTMP , 5 , NUM , NERROR , TENTXP ) 

CALL  F I LEO ( NAMTMP (11) , RUNTMP , 5 ,NUM .NERROR ,TETHNP) 

CALL  F I LEO C NAMTMP ( 1 2 ) , RUNTMP , 5 , NUM . NERROR , PS I ) 

CALL  F I LEO ( NAMTMP (13)  ,R UNTMP , 6 , NUM , NERROR , TOXQP ) 

CALL  F I L E 0 ( NAMTM P < 1 4 ) , R UNTMP , 6 , NUM , N E R R 0 R . T 0 Y C F 
CALL  FI  LEO (NAMTMP C 15) , RUNTMP , 6 , NUM , NERROR .TCZOF > 

CALL  F I LEO C NAMTMP ( 16), RUNTMP ,10, NUM , NERROR , FC  OP . 

CALL  FILEOC NAMTM P ( 17) ,R UNTM P , 1 0 , N UM , N E R R OR , FOY 0 P 
CALL  FI LEOCNAMTMPC 18) , RUNTMP ,10 , NUM .NERROR , FCZ OF 
CALL  FI LEOCNAMTMPC 19) , RUNTMP , 6 ,NUM , NERROR , tlXLP • 

CALL  FI LEOCNAMTMPC 20) , RUNTMP , 6 ,NUM , NERROR , T1YLP) 

CALL  FI LEOCNAMTMPC 21) , RUNTMP , 6 ,NUM , NERROR , T1ZLP ) 

CALL  FI LEOCNAMTMPC 22) , RUNTMP , 6 , NUM , NERROR , T1XTP ) 

CALL  FI LEOCNAMTMPC 23) , RUNTMP , 6 ,NUM , NERROR , T 1YTP ) 

CALL  FI LEOCNAMTMPC 24) , RUNTMP , 6 ,NUM .NERROR ,T1ZTP) 

RETURN  • 

END 


^ ^ ^ o*c  **■  "A*  “**  ''V* 


SUBROUTINE  FI  LEG (NAMTMP , RUNTMP . UNTTMP , NUMBER .NERROR , ARRAt  > 
C 
C 
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BYTE  UN ITS (100) 

INTEGEP.*2  NUMB (100) 

C HA  R A CT  E R* € NAMTM P , R UNTM P , NAM E < 1 0 0 ) , R UN ( 1 0 0 ) 
INTEGER  UNTTMP , NUMBER , NERROR ,NUAP. 

REAL  ARRAY ( NUMBER ) , M I N ( 1 0 0 ) , MAX (100 ) 


READ  ( 1 , REC=1 ) NUAR  , NAME  , RUN , MAX  , M I N , UN  I TS  , NUMB 
NUAR=NUAR+1 


MAX (NUAR) =-99999999 . 99 
MIN(NUAR) =99999999 . 99 

DO  1 I =2, NUMBER 

TMPMAX=AMAX1 ( ARRAY ( I -1 ) , ARRAY ( I ) ) 
MAX ( NUAR ) =AMAX1 ( MAX ( NUAR ) , TMPMAX ) 


TMPMIN=AMIN1 (ARRAY ( I -1 ) , ARRAY ( I ) ) 

M I N ( NUAR ) =AM I N1 ( M I N ( NUAR ) , TMPMIN) 
1 CONTINUE 


NAME ( NUAR ) =NAMTMP 
RUN  ( NUAR  ) =PJJNTMP 
UN  I T S ( NUAR  ) = UNTTMP 
NUMB ( NUAR ) =N UMBER 


C 

900 


WR I TE ( 1 , REC=1 , ERR=90 0 ) NUAR , NAME , RUN , MAX , M I N , UN I TS , NUMB 

NRITEd ,REC=(NUAR+1) , ERR=900 ) ( ARRAY ( I ) , 1=1 , NUMBER) 

RETURN 

NERR0R=1 

RETURN 

END 
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SUBROUTINE  TRQPHOR  (HEAD) 
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TRQPHO.  FOR 

7/12/83.  J. B.  VARIABLE  ANXXOS=ANXOP  IS 

IMPLEMEMTED/1 1 CHANGES 

BYTE  UNITS! 100) 

INTEGER *2  NUMB (100) 

INTEGER  RECLEN,  MREC,  NVAR.  NP ( 18) . NERROR.  RECNM< 18),  TYPE(2> 

REAL  AAXX0S!600) , AAYXOS ( 600 ) , AAZXOSC  600) » PHAOXP ( 600) , 

& PHB02P ( 600 ) , PHC03P ( 600 ) , QHAOXS ( 600 ) , QHBOXS ( 600 ) , QHCOXS  < 600 ) , 

& RHAOXS ( 600 ) , RHBOXS ( 600 ) . RHCOXS ( 600 ) , PNAOXP ( 600 ) . PNB02P ( 600  > , 

Sc  PNC03P ( 600 ) , ANX XOS ( 600 ) . MIN < 1 00 > . MAX ( 100 ) , TARR AY ( 600 ) , 

& VNXX0S(600) 

CHARACTER*6  NAME! 100),  RUN! 100) , VRBLS! 18),  FILNM,  NAMTMP 

PARAMETER  (MREC-101) 

PARAMETER  (RECLEN* 598) 

COMMON/ INDATA/TARR AY, PHAOXP,  PHB02P,  PHC03P,  RHAOXS,  RHDOXS,  RHCOXS 
Sc  QHAOXS, QHBOXS, QHCOXS. AAXXOS, AAYXOS,  AAZXOS, PNAOXP. PNB02P, 

Sc  PNC03P, ANX XOS. VNXXOS 

DATA  VRBLS/  'PHAOXP  '»  'PHB02P  '.  'PHC03P  '«  'RHAOXS',  'RHBOXS', 

& 'RHCOXS',  'QHAOXS',  'QHBOXS'.  'QHCOXS',  'AAXXOS',  'AAYXOS', 

Sc  'AAZXOS',  'PNAOXP',  'PNB02P ',  'PNC03P  ',  'TIME',  'ANXXOS', 

Sc  'VNXXOS'/ 

DATA  TYPE/ 'OPEN',  'READ'/ 


STEP  1:  OPEN  INPUT  FILE 

/ 

OPENCUNIT-1.  FILE-  'SCRTCH ',  RECL*RECLEN,  STATUS*  'OLD ',  ERR=999, 

Sc  FORM* 'UNFORMATTED ',  ORGANIZATION* 'RELATIVE ', ACCESS* 'DIRECT ' ) 


STEP  2:  READ  IN  DIRECTORY 


READ! 1,  REC*1 )NVAR» NAME,  RUN.  MAX,  MIN,  UNITS,  NUMB 


STEP  3:  TEST  FOR  EX I STANCE  OF  VARIABLES 


DO  1 1*1, 18 
DO  2 N-l.NVAR 

IF ( NAME (N).  NE.  VRBLS!  I ) )G0  TO  3 
NP  ( I ) *NUMB ! N ) 

RECNM! I )*N+1 
CO  TO  1 

IF(N.  EQ.  NVAR)GO  TO  900 
CONTINUE 
CONTINUE 


STEP  4:  READ  APPROPRIATE  RECORD 
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C 

READ ( 1 » REC-RECNM ( 1 > > ( PHAOXP ( K ) , K=  1 , NP ( 1 ) ) 
READd.  REC=RECNM(2> ) (PHB02PUO,  K-l.  NP<2> ) 
READd, REC=RECNM(3) ) (PHC03P (K> . K=l.  NP(3> > 
READ < 1 * REC»RECNM(4> ) (RHAOXS(K).  K-l.  NP(4) ) 
READ  < 1 . REC-RECNM ( 3 ) ) ( RHBOXS ( K > . K- 1 . NP ( S > > 
READd,  REC»RECNM(6> ) (RHCOXS(K),  K-l.  NP(6>  ) 
READ  < 1 , REC-RECNM < 7 ) ) ( QHAOXS ( K ) . K» 1 . NP ( 7 ) ) 
READ< 1.  REC-RECNM(8) > (QHBOXS(K),  K-l.  NP(8) ) 
READ< 1,  REC-RECNM ( 9 > ) (QHCOXS(K).  K-l,  NP(9) ) 
READ(1.  REC-RECNM (10)  XAAXXOS(K),  K-l.  NPdO)  ) 
READd.  REC-RECNM ( 11) ) ( AAYXOSCK) . K-l.  NPdl ) ) 
READ( 1.  REC-RECNM ( 12) ) < AAZXOS(K) , K-l.  NP(12) ) 
READ ( 1 . REC-RECNM  d 3 ) ) < PNAOXP ( K ) , K» 1 , NP  < 13 ) ) 
READ ( 1 . REC-RECNM  < 1 4 ) ) < PNB02P ( K ) . K- 1 , NP  d 4 ) ) 
READd,  REC-RECNM <15)  ) (PNC03P  <K> , K-l,  NP(15)  ) 
READ ( 1 , REC-RECNM (16 ) ) ( TARR AY ( K > . K= 1 , NP (1 6 > > 
READd,  REC-RECNM (17)  ) ( ANXXOS(K) , K-l.  NP(17>  ) 
READd.  REC-RECNM ( 18) ) < VNXXOS(K) , K-l.  NP  ( 18)  > 
C 

10  CONTINUE 
NERROR-O 


NAMTMP— RUN  < RECNM  < 1 )-l ) 

NUM—NP (16) 

CALL  TORQP(NERROR.  NAMTMP,  NUM) 

IF(NERROR.  NE.  0)00  TO  999 
00  TO  1000 


ERROR  MESSAGES 
O WRITE (6,  901 ) VRBLS( I ) 

U FORMAT  (IX,  'VARIABLE',  IX,  A10,  IX,  'IS  NOT  IN  THE  INPUT  FILE',/, 

+ IX,  'YOU  ARE  ABOUT  TO  BE  RETURNED  TO  MONITOR  LEVEL  TO 

+ IX,  'TRY  AND  RECTIFY  THE  PROBLEM',///) 


GO  TO  1000 


999  WRITE (6,  902 > TYPE ( NERROR > 

C 

902  FORMAT( IX,  AS,  'ERROR  ENCOUNTERED'/. 

+ IX,  'PROGRAM  HALT',///) 

C 

1000  CONTINUE 
C 

CLOSE ( UNIT— 1 ) 

END 

***************************************************************** 
********************************************************** «*•***♦ 
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SUBROUTINE  TORQP (NERROR,  RUNTMP.  NUM) 

COMMON  DATA  FOR  THE  HEAD  TORQUE  PROGRAM  (PHOTOGRAPHIC  DATA) 

REAL  AAXX0S(600),  AAYX0S(600).  AAZX0S(600),  PHA0XP(600), 

& PHB02P (600) > PHC03P (600) # QHAOXS ( 600 ) , GHB0XS<  600 ) > QHCOXS (600 ) . 

& RHAOXS ( 600 ) , RHBOXS ( 600 ) » RHC0XS(600) » PNAOXP (600) , PNB02P ( 600 ) , 

& PNC03P(600),  ANXX0S(600),  TARRAYC600).  VNXX0S(600) 

COMMON/INDATA/TARRAY.  PHAOXP,  PHB02P,  PHC03P,  RHAOXS.  RHBOXS,  RHCOXS, 
8c  QHAOXS.  QHBOXS,  QHCOXS,  AAXXOS,  AAYXOS.  AAZXOS,  PNAOXP.  PNB02P. 

8c  PNC03P.  ANXXOS.  VNXXOS 

4TH  EDITION  OF  2/22/83 
FILE:  T0RQP3.  FOR 

COMPUTATION  OF  MOMENTS  AND  FORCES  AT  THE  OCCIPITAL  CONOYLES 
DUE  TO  HEAD  DECELERATION  AND  GRAVITY  AS  DERIVED  FROM 
PHOTOGRAPHIC  DATA 

PROGRAM  CONSTANTS  — DIFFERENT  FOR  EACH  SUBJECT  # 

MH-MASS  OF  HEAD 

C=ACCEL.ERATION  OF  GRAVITY  AT  NBDL 
RGAX  ■ THE  COMPONENT  OF  LINEAR  POSITION  OF  THE 
HEAD  CENTER  OF  GRAVITY  ALONG  THE  X-AXIS 
OF  THE  HEAD  ANATOMICAL  COORDINATE  SYSTEM. 

RGAZ  - SAME  AS  ABOVE  EXCEPT  FOR  THE  Z-AXIS. 

RGOX  - THE  COMPONENT  OF  LINEAR  POSITION  OF  THE 
HEAD  CENTER  OF  GRAVITY  ALONG  THE  X-AXIS 
OF  THE  HEAD  ANATOMICAL  COORDINATE  SYSTEM  MEAURED 
FROM  THE  OCCIPITAL  CONDYLES. 

RGOZ  ■ SAME  AS  ABOVE  EXCEPT  FOR  THE  Z-AXIS. 

IX. IY, IZ  - THE  COMPONENT  OF  CENTRO I DAL  MASS  MOMENT 

OF  INERTIA  OF  THE  INSTRUMENTED  HEAD  ABOUT  AN 
AXIS  PARALLEL  TO  THE  X,  Y«  Z-AXIS  OF  THE 
HEAD  ANATOMICAL  SYSTEM.  RESPECTIVELY. 

PXY  - THE  COMPONENT  OF  CENTRO I DAL  MASS  PRODUCT  OF  INERTIA 
OF  THE  INSTRUMENTED  HEAD  ABOUT  AN  AXIS  PARALLEL 
TO  EITHER  THE  XOR  Y AXIS  OF  THE  HEAD 
ANATOMICAL  COORD.  SYSTEM  AND  DEFINED  BY  AN 
INTEGRAL  OF  XYD(MH). 

PXZ,  PYX, PYZ, PZX, PZY  - SAME  AS  ABOVE  EXCEPT  FOR 
THE  RESPECTIVE  AXES. 

PROGRAM  VARIABLES  (ARRAYS) 

PHAOXP=ANCLE  ROTATION  OF  THE  HEAD  ABOUT  THE  X AXIS  OF 

THE  HEAD  ANATOMICAL  COORD.  SYSTEM  AS  DERIVED  FROM 
PHOTOGRAPHIC  DATA 

PHB02P»SAME  AS  ABOVE  EXCEPT  FOR  THE  Y AXIS 

PHC03P»SAME  AS  ABOVE  EXCEPT  FOR  THE  Z AXIS 

RHAOXS=ANGULAR  VELOCITY  OF  THE  HEAD  ABOUT  THE 
X AXIS  OF  THE  HEAD  ANATOMICAL  COORD. 

SYSTEM  AS  DERIVED  FROM  ACCELEROMETER 
DATA 

RHBOXS=SAME  AS  ABOVE  EXCEPT  FOR  THE  Y AXIS 

RHCOXS»SAME  AS  ABOVE  EXCEPT  FOR  THE  Z AXIS 

QHAOXS- ANGULAR  ACCELERATION  OF  THE  HEAD 

ABOUT  THE  X AXIS  OF  HEAD  ANATOMICAL 
COORD.  SYSTEM  AS  DERIVED  FROM 
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ACCELEROMETER  DATA 

QHBOXS=SAME  AS  ABOVE  EXCEPT  FOR  THE  Y AXIS 
QHC 0 X S=S AME  AS  ABOVE  EXCEPT  FOR  THE  Z AXIS 
AAXXOS=THE  X COMPONENT  OF  ACCELERATION  OF 
THE  HEAD  ANATOMICAL  ORIGIN  (THE 
LABORATORY  COORD.  SYSTEM)  WITH 
RESPECT  TO  THE  FIXED  LABORATORY 
COORD.  SYSTEM  AS  DERIVED  FROM 
ACCELEROMETER  DATA 

AAYXOS=SAME  AS  ABOVE  EXCEPT  ABOUT  THE 
Y AXIS 

AAZXOS=SAME  AS  ABOVE  EXCEPT  ABOUT  THE 
Z AXIS 

PNAOXP=ANCLE  OF  ROTATION  OF  THE  HEAD  ABOUT  THE 
X AXIS  OF  THE  HEAD  ANATOMICAL  COORD. 

SYSTEM  (INITIALLY  ALIGNED  WITH  THE  LABORATORY 
COORD.  SYSTEM)  AS  DERIVED  FROM  ACCELEROMETER 
DATA 

PNB02P-SAME  AS  ABOVE  EXCEPT  ABOUT  THE  CARRIED  X AXIS 
PNC03P=SAME  AS  ABOVE  EXCEPT  ABOUT  THE  CARRIED  Z AXIS 
TARRAY*TIME  MARKS  OF  DATA  POINTS  RECORDING 
ANXXOS=THE  COMPONENT  OF  LINEAR  ACCELERATION 

OF  THE  Ti  ANATOMICAL  ORIGIN  ALONG  THE 
X-AXIS  OF  THE  LABORATORY  COORDINATE 
SYSTEM  WITH  RESPECT  TO  THE  FIXED 
LABORATORY  COORDINATE  SYSTEM  AS  DERIVED 
FROM  Tl  MOUNT  ACCELEROMETER  DATA 
VNXXOS-THE  COMPONENT  OF  LINEAR  VELOCITY  OF  THE 
Tl  ANATOMICAL  ORIGIN  ALONG  THE 
X-AXIS  OF  THE  LABORATORY  COORDINATE  SYSTEM 
WITH  RESPECT  TO  THE  FIXEDLABORATORYCOORDINAT 
SYSTEMAS  DERIVED  FROM  Tl  MOUNT  ACCELEROMETER 
DATA. 

OUTPUT  VARIABLES  (ARRAYS) 

ACXP-X— COMPONENT  OF  ACCELERATION  OF  THE  HEAD  C.  G.  (THE  HEAD 
ANATOMICAL  C.  S.  > WRT.  THE  LABORATORY  COORD  SYSTEM 
AS  DERIVED  FROM  PHOTOGRAPHIC  DATA 
AOYP.AGZP-Y-  AND  Z-COORDINATES  OF  THE  ABOVE 
TOXP»THE  COMPONENT  OF  MOMENT  APPLIED  BY  THE  NECK  TO  THE 
HEAD  ABOUT  AN  AXIS  PARALLEL  TO  THE  X AXIS  OF  THE 
HEAD  ANATOMICAL  COORD.  SYSTEM  AS  DERIVED  FROM 
PHOTOGRAPHIC  DATA 

TOYP.  TOZP*SAME  ABOUT  THE  Y-  AND  Z-AXES 

FOXP-THE  COMPONENT  OF  FORCE  APPLIED  BY  THE  NECK  TO  THE 
HEAD  AT  THE  OCCIPITAL  CONDYLE  PARALLEL  TO 
THE  X AXIS  OF  HEAD  ANATOMICAL  COORD. 

SYSTEM  AS  DERIVED  FROM  PHOTOGRAPHIC  DATA 
FOYP,  FOZP-SAME  ABOUT  THE  Y AND  Z AXES 
THTIYP-THE  ANOLE  OF  ROTATION  OF  A PLANE  FORMED 
BY  THE  Y AXIS  OF  THE  Tl  ANATOMICAL 
COORD.  SYSTEM  AND  A UNIT  VECTOR  ALONG 
THE  Z AXIS  OF  THE  HEAD  ANATOMICAL  COORD 
SYSTEM  WITH  RESPECT  TO  THE  PLANE  FORMED 
BY  THE  Y AND  Z AXES  OF  THE  Tl  ANATOMICAL 
COORD.  SYSTEM 

THTIXP-THE  ANCLE  OF  ROTATION  OF  A PLANE  FORMED 

BY  THE  X-AXIS  OF  THE  Tl  ANATOMICAL  COORD 
SYSTEM  AND  A UNIT  VECTOR  ALONG  THE  Z 
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AXIS  DF  THE  HEAD  ANATOMICAL  COORD*.  SYSTEM 
WITH  RESPECT  TO  THE  PLANE  FORMED  BY  THE 
X AND  Z AXES  OF  THE  T1  ANATOMICAL  COORD. 

SYSTEM 

TOXLP=THE  COMPONENT  OF  MOMENT  APPLIED  BY  THE  NECK 
TO  THE  HEAD  ABOUT  AN  AXIS  PARALLEL  TO  THE 
LABORATORY  X-AXIS  AND  PASSING  THROUGH  THE  ORIGIN 


OF  THE  OCCIPITAL  COORDINATE  SYSTEM 

TOYLP-THE  COMPONENT  OF  MOMENT  APPLIED  BY  THE  NECK  TO  THE 
HEAD  ABOUT  AN  AXIS  PARALLEL  TOTHE  LABORATORY 
Y-AXIS  AND  PASSING  THROUGH  THE  ORIGIN  OF  THE 
OCCIPITAL  COORDINATE  SYSTEM 

TOZLP-THE  COMPONENT  OF  MOMENT  APPLIED  BY  THE  NECK 

TO  THE  HEAD  ABOUT  AN  AXIS  PARALLEL  TO  THE  LABORATORY 
Z-AXIS  AND  PASSING  THROUGH  THE  ORIGIN  OF  THE  NECK 
CHORD  COORDINATE  SYSTEM 

FOXLP-THE  COMPONENT  OF  FORCE  APPLIED  BY  THE  NECK  TO  THE 

HEAD  PARALLEL  TO  THE  LABORATORY  X-AXIS  AND  PASSING 
THROUGH  THE  ORIGIN  OF  THE  OCCIPITAL  COORDINATE 
SYSTEM 

FOYLP-THE  COMPONENT  OF  FORCE  APPLIED  BY  THE  NECK  TO  THE 

HEAD  PARALLEL  TO  THE  LABORATORY  Y-AXIS  AND  PASSING 
THROUGH  THE  ORIGIN  OF  THE  OCCIPITAL  COORDINATE 
SYSTEM 

FOZLP-THE  COMPONENT  OF  FORCE  APPLIED  BY  THE  NECK  TO  THE 
HEAD  PARALLEL  TO  THE  LABORATORY  Z-AXIS  AND 
PASSING  THROUGH  THE  ORIGIN  OF  THE  OCCIPITAL 
COORDINATE  SYSTEM 

TOXTP-THE  COMPONENT  OF  MOMENT  APPLIED  BY  THE 

NECK  TO  THE  HEAD  ABOUT  THE  X-AXIS  OF  THE  TIO 
COORDINATE  SYSTEM 

TOYTP-THE  COMPONENT  OF  MOMENT  APPLIED  BY  THE  NECK  TO  TT 
THE  HEAD  ABOUT  THE  Y-AXIS  BY  THE  TIO  COORDINATE 
SYSTEM 

TOZTP-THE  COMPONENT  OF  MOMENT  APPLIED  BY  THE  NECK  TO  THE 
HEAD  ABOUT  THE  Z-AXIS  OF  THE  TIO  COORDINATE 
SYSTEM 

FOXTP-THE  COMPONENT  OF  FORCE  APPLIED  BY  NECK  TO  THE 
HEAD  ALONG  THE  X-AXIS  OF  THE  TIO  COORDINATE 
SYSTEM 

FOYTP=THE  COMPONENT  OF  FORCE  APPLIED  BY  THE  NECK  TO 
HEAD  ALONG  THE  Y-AXIS  OF  THE  TIO  COORDINATE 
SYSTEM 

FOZTP=THE  COMPONENT  OF  FORCE  APPLIED  BY  THE  NECK  TO  THE 

HEAD  ALONG  THE  Z-AXIS  OF  THE  TIO  COORDINATE  SYSTEM 

ANXOP=ANXXOS 

VNXOP-VNXXOS 


REAL  AG XP ( 600 ) . AGYP ( 600 ) . AGZP  < 600 ) , TOXP ( 600 ) , TOYP ( 600 ) , 

*c  TOZP  ( 600 ) , FOXP  < 600 ) . FOYP  ( 600 > , FOZP  < 600 ) . THT I YP  ( 600 ) , 

& THT I XP ( 600 ) . TOXLP ( 600 ) , T0YLP<600>,  TOZLP (600) , FOXLP (600 ) , 

& FOYLP < 600 > * FOZLP ( 600 ) . T0XTP<600>,  T0YTP<600>, T0ZTP<600>» 

Sc  FOXTP ( 600  > . FOYTP ( 600 ) . FOZTP ( 600 ) , ANXOP ( 600 ) , VNXOP ( 600  > 

CHAR ACTER*6  NAMTMP < 25  > , RUNTMP 
INTEGER  NERROR 
REAL  IX*  IY#  IZ,  MH 

DATA  NAMTMP  /'TOXP'.  'TOYP'.  'TOZP',  'THTIYP  '»  'THTIXP'.  'AGXP', 

Sc  'AGYP  '»  'AGZP'.  'FOXP'.  'FOYP',  'FOZP'.  'TOXLP',  'TOYLP  ' , 'TOZLP', 
& 'FOXLP'.  'FOYLP',  'FOZLP'.  'TOXTP',  'TOYTP  ',  'TOZTP',  'FOXTP', 


/ 
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non 


Sc  'FOYTP  '»  'FOZTP  '«  'ANXOP  ' > 'VNXOP'/ 


SUBJECT  NUMBER  SELECTION 

1700  CONTINUE 
READ <5,  *>NJCT 
WRITE (A* 1755) NJCT 

1755  FORMAT <5X,  'SUBJECT  NUMBER3* ' « 15) 

IF(NJCT.  EQ.  1)G0  TO  1001 
IF < NJCT.  EQ.  83)00  TO  1083 
IF ( NJCT.  EQ.  93)00  TO  1093 
IF(NJCT.  EQ.  96)00  TO  1096 
IF(NJCT.  EQ. 44>C0T0  1044 
IF ( NJCT.  EQ.  64) GOTO  1064 
IF ( NJCT.  EQ.  65) GOTO  1065 
IF ( NJCT.  EQ.  67) GOTO  1067 

1701  CONTINUE 
WRITE (6.  1702) 

1702  FORMAT (IX#  'INCORRECT  SUBJECT  NUMBER') 

STOP 

C 

1001  CONTINUE 

MH=4.  6 
RGAX-O.  012 
RGAZ-O.  029 
RGOX-O.  0234 
RCOZ-O.  055 
IX-O.  0215 
IY=0.  0278 
IZ-O.  0179 
PXY—O.  000 
PYX— 0.  000 
PXZ— 0.  0057 
PZX— O.  0057 
PYZ=0.  000 
PZY-O.  000 
ROOY-O.  0 
CO  TO  999 

C 

1083  CONTINUE 
MH=4.  532 
RGAX“0.  012 
RGAZ=0.  029 
RG0X=*0.  023 
RG0Z=0.  055 
IX=0.  0211 
IY=0.  0261 
IZ»0.  0174 
PXY-0 
PYX=»0. 

PXZ—  0056 
PZX—.  0056 
PYZ=0. 

PZY-O. 

RGOY—O.  0 
GO  TO  999 

C 

1093  CONTINUE 
MH-4.  03 
RGAX-O.  012 


! 
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RGAZ-O. 029 
RG0X-0.  023 
RGQZ-0.  055 
IX=0.  0174 
IY-0.  0215 
IZ-0.  0142 
PXY=0. 

PYX=0. 

PXZ— 0.  0049 
PZX— 0.  0049 
PVZ=0. 

PZY*0. 

RC0Y-0. 

GO  TO  999 

C 

1044  CONTINUE 
MH-4.  37 
RCAX-O.  012 
RGAZ-  029 
RGOX-.  023 
RGOZ-.  055 
IX-.  0200 
IY-.  0258 
IZ-.  0166 
PXY*0.  0 
PYX-O.  0 
PXZ— . 0053 
PZX— . 0053 
PYZ-O.  0 
PZY-O.  O 
RGOY-O.  0 
GO  TO  999 

C 

1064  CONTINUE 
MH-4.  90 
RGAX-.  012 
RGAZ*.  029 
RGOX— . 023 
RGOY-O. 
RGOZ-.  055 
IX-  0236 
IY-.  0306 
IZ-  0198 
PXY-O. 

PYX— 0. 
PXZ*-.  0058 
PZX—.  0058 
PYZ=0. 
PZY*0. 

GOTO  999 

C 

1065  CONTINUE 
MH=5.  11 
RGAX*.  012 
RGAZ*.  029 
RGOX-  023 
RGOY-O. 
RGOZ— . 055 
IX-.  0250 
IY— . 0335 
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c 

1067 


C 

1096 


C 

1725 

C 

999 


C 


IZ-.  0211 
PXY-0. 

PYX-0. 

PXZ— . 0060 
PZX— . 0060 
PYZ-0. 

PZY-0. 

GOTO  999 

CONTINUE 
MH=4.  66 
RGAX-.  012 
RCAZ-.  029 
RGOX-.  023 
RGOY-O. 

RGOZ-.  055 
IX*.  0220 
IY-. 0290 
IZ*.  0184 
PXY*0. 

PYX*0. 

PXZ—.  0057 
PZX— . 0057 
PYZ*0. 

PZY*0. 

GOTO  999 

CONTINUE 

MH-O. 

RGAX-O.  012 
RGAZ-O.  029 
RG0X*0.  023 
RG0Z*0.  055 
IX-0 
IY*0. 

IZ«0. 

PXY-O. 

PYX-O. 

PXZ-O. 

PZX-O. 

PYZ-O. 

PZY»0. 

RGOY-O. 

GO  TO  999 

CONTINUE 

CONTINUE 
DELT-O.  0005 
C-9.  81 

TPMAX-T ARRAY ( NUM ) 

TSMA  X -DELT * 598 

IF(TPMAX.  LE.  TSMAX)CO  TO  55 

DO  11  K-l.NUM 

Kl-K 

TAR— TARRAY ( K1 ) 

IF  <TAR.  LE.  TSMAX)GO  TO  11 
KC-K 

KMAX-KC-1 


C-lll 


GO  TO  22 
C 

li  CONTINUE 
22  CONTINUE 
C 

NUM*KMAX 

C 

35  CONTINUE 

C 

TETlXO-PNAOXP(l) 

TET1Y0-PNB02P<1) 

TET1Z0*PNC03P<1) 

C 

C MATRIX  P — FOR  EQUATIONS  (19) 

C 

P 1 1 “COS ( TET 1 ZO  > *COS ( TET 1 YO ) 

P211=C0S(TET1X0)*SIN(TET1Z0) 

P21 2=C OS  < TET 1 ZO  > *S I N < TET 1 YO ) *S I N < TET 1 X 0 > 
P21*P21 1+P212 

P3tl«SIN(TETlZ0)*SIN<TETlX0) 

P312— COS  ( TET1  ZO ) *SIN  ( TET1  YO ) *COS  ( TET  1 XO ) 
P31-P311+P312 

P 1 2=-S I N ( TET 1 Z 0 ) *C OS ( TET 1 YO ) 

P221-C0S ( TET1 ZO ) *COS ( TET 1 XO ) 

P222*— SIN(TET1Z0)*SIN(TET1Y0)*SIN<  TET1XO) 
P22-P221+P222 

P321*C0S ( TET 1 ZO ) *S IN ( TET 1 XO ) 

P322“S I N < TET 1 ZO ) *S IN ( TET 1 YO ) *COS ( TET 1X0) 
P32-P321+P322 
P13»SIN(TET1Y0) 

P23— COS  C TET  1 YO ) *S  I N < TET  1 XO ) 

P33-C0S ( TET1 YO ) *COS ( TET 1X0) 

C 

C 

JsO 

c 

10  CONTINUE 
I-I+l 

IF( I. EQ.  (NUM+1 ) )G0  TO  100 
TAR-TARRAY(I) 

DO  33  J-l.  398 
JCOPY-J 

TIME»DELT*JCOPY 
IF ( TIME.  LT.  TAR) GO  TO  33 
C 
C 
C 
C 

I2-JC0PY 
GO  TO  44 
33  CONTINUE 

44  CONTINUE 

11*12-1 

C CALCULATION  OF  THE  NEEDED  VARIABLES 

C THROUGH  INTERPOLATION  OF  ACCELEROMETER 

C DATA 

C 

TAR-TARRAY(I) 

CF» ( TAR-DELT* 1 1 ) /DELT 
FC-1. -CF 


, 


nnnn  o o o o o o o n 


TETAX=PHAOXP ( I ) 

TETAY=PHB02P  < I ) 

TETAZ-PHC03P ( I ) 

ALFX=FC*QHAOXS  (ID  +CF*QHAOXS  ( 12 ) 
ALFY=FC*GHBOXS( II )+CF*QHBOXS( 12) 
ALFZ*FC*QHCOXS  (ID  +CF*QHCOXS  ( 12 ) 
AACX«FC*AAXXOS (ID  +CF*AAXXOS ( 12 ) 

AAC Y-FC*AAYXOS  (ID  +CF*AAYXOS  (12) 
AACZ-FC*AAZXOS ( I 1 ) +CF*AAZXOS ( 12 ) 
WX*FC*RHAOXS( I 1 )+CF*RHAOXS( 12) 
WY»FC*RHBOXS ( I 1 ) +CF*RHBOXS (12) 
WZ»FC*RHCOXS( I 1 )+CF*RHCOXS( 12) 

ANXOP  ( I ) -FC*ANXXOS  (ID  +CF*ANXXOS  ( 12 ) 
VNXOP( I )»FC*VNXXOS( I1)+CF*VNXX0S( 12) 

EQUATIONS  (13) 

#*♦*#**■»***■*** 


Q 1 1—  S IN  ( TETAZ ) *S  I N ( TETAX ) 

C 1 2=C0S ( TETA  Z ) *SIN( TET AY > *COS ( TET A X ) 
CX=(C11+C12)*C 

C21— COS(TETAZ)*SIN(TETAX) 

C22— S I N ( TETAZ ) *S  IN  ( TETAY ) *COS  ( TETAX ) 
CY*(C21+«22)*G 

CZ» ( -COS ( TETAY ) *COS ( TETAX ) ) *G 

EQUATIONS  (17) 

********■»*•»*•»** 


A 1 1 «COS ( TETAZ ) *COS ( TETA Y ) 

A121«C0S( TETAX )*SIN( TETAZ) 

A 1 22® COS ( TETAZ ) *S I N ( TETAY ) *S I N ( TET AX ) 

- A12»A121+A122 

A131*SIN(TETAZ )*SIN( TETAX  > 

A 1 32— COS  < TETAZ ) *S  I N ( TETAY  > *COS  ( TETA  X ) 
A13-A131+A132 
A21— S IN  ( TETAZ  ) *COS  ( TETAY ) 

A221-C0S ( TETAZ ) *COS ( TETAX ) 

A222— S I N ( TETAZ ) *S  I N ( TETAY ) *S  I N ( TET  A X ) 
A22® A22 1 +A222 

A231»C0S ( TETAZ ) *SIN ( TETAX ) 

A232*S I N ( TETAZ ) *S I N ( TETAY ) *COS ( TETA  X ) 
A23-A231+A232 
A3 1®SIN( TETAY) 

A32“— COS ( TETAY ) *S I N ( TETAX ) 

A33=C0S ( TETAY ) *COS ( TETAX ) 

AAX=A1 1 *AAC  X+ A 1 2*  AAC  Y+ A 1 3*  A AC  Z 
A A Y= A2 1 * A AC  X + A22* A AC  Y + A23* A AC Z 
AA  Z- A3 1 * AAC  X+ A32* A AC Y+ A33* A AC  Z 

EQUATIONS  (18) 

*************** 


B 1 1 — ( WZ**2+WY**2 ) *RGAX 
B12«WX*WZ*RGAZ 
B 1=>B  1 1+B 12 

B21-UX#UZ#RGAX 

B22=WY*WZ*RGAZ 

B2*B21+B22 

B31-WX*WZ*RGAX 
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B32—  ( WX**2+WY**2 ) *RGAZ 
B3=B31+B32 
C 1 =RGAZ*ALFY 

C21*RGAX*ALFZ 

C22=-RGAZ*ALFX 

C2=C2i+C22 

C3=-RGAX*ALFY 

AGX=AAX+B1+C1 

ACY=AAY+B2+C2 

AGZ»AAZ+B3+C3 


EQUATIONS  (15) 

T11«IX*ALFX 

T12«IY*ALFY 

T13«IZ*ALFZ 

T21«(IZ-IY)*WY*WZ 

T22-(IX-IZ)*WX*WZ 

T23»(IY-IX)*WX*WY 

T3 1 1 -MH*RCOZ  * ( CY-AC Y ) 
T312=-MH*RG0Y* (GY-AGZ > 
T31-T311+T3I2 

T321— MH*RCOZ*  ( CX-AGX ) 
T322=MH*RG0X* ( GZ-AGZ ) 
T32=T32 1 +T322 

T331— MH*RCOX*  < CY-AGY ) 
T332»MH*RC0Y* ( CX-AGX ) 
T33=T33 1 +T332 
T41— PXY*ALFY-PXZ*ALFZ 
742— PYX*ALFX-PYZ*ALFZ 
T43— PZX*ALFX-PZY*ALFY 
T51i«PYX*WX*WZ 
T512-PYZ*(WZ**2) 

T513— PZX*WX*WY 
T514— PZY*(WY**2) 
T51-T51 1+T512+T513+T514 
T521— PXY*WY*WZ 
T522—PXZ*  < WZ**2 ) 
T523»PZX*(WX**2) 
T524»PZY*WX*WY 
T52-T52 1 +T522+T523+T524 
T531»PXY*(WY**2) 
T532=PXZ*WY*WZ 
T533—PYX*  < WX**2 ) 
T534=— PYZ*WX*WZ 
T53*T53 1 +T 532+T 533+T 534 
TOX-T1 1+T21+T31+T41+T51 
TO Y=T 1 2+T22+T32+T42+T 52 
TOZ»T 1 3+T23+T33+T 43+T53 

EQUATIONS  (16) 

*************** 


FOX»MH*(ACX-GX) 
FOY*MH* ( AGY-GY ) 
FOZ=MH* ( ACZ— CZ ) 

EQUATIONS  (22) 
*************** 
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T0XL-T0X*A11+T0Y*A21+T0Z*A31 

T0YL=T0X*A12+T0Y*A22+T0Z*A32 

T0ZL=T0X*A13+T0Y*A23+T0Z*A33 

EQUATIONS  (23) 
**************** 


F0XL=F0X*A1 i+F0Y*A21+F0Z*A31 
F0YL«F0X*A12+F0Y*A22+F0Z*A32 
FO  ZL-FOX* A 1 3+FO Y* A23+F0Z  * A33 
OUTPUT  VARIABLES  (ARRAYS) 

ACXP ( I )— ACX 
AGYP(I)-AQY 
ACZP(I)-AQZ 
TOXP ( I )— TOX 
TOYP(I)«TOY 
TOZP(I)-TOZ 
FOXP(I)»FOX 
FO YP  < I ) — FO  Y 
FOZP ( I )-FOZ 
TOXLP(I)=TOXL 
TOYLP ( I ) -TOYL 
TOZLP(I)»TOZL 
FOXLP ( I ) *FOXL 
FOYLP ( I ) *FOYL 
FOZLP(I)-FOZL 
EQUATIONS  (19) 

*************** 

TETAIX-PNAOXP(I) 

TETA1Y»PNB02P(I) 

TETA1Z“PNC03P ( I ) 

Dll -COS ( TETA 1 Z ) *COS ( TETA 1 Y ) 

D2 1 — S I N ( TETA 1 Z ) *COS ( TETA 1 Y ) 

D31=SIN(TETA1Y) 

D121«C0S(TETA1X)*SIN(TETA1Z) 
D122*C0S(TETA1Z  >*SIN(TETA1Y) *SIN(TETA1 X ) 
D12=D121+D122 

D221-C0S ( TETA1Z ) *COS ( TETA 1 X ) 

D222=-S I N ( TETA 1 Z ) *S I N ( TETA 1Y)*SIN(TETA1X) 
D22-D22 1 +D222 

032=— C OS ( TETA 1 Y ) *S I N ( TETA 1 X ) 

D131=SIN(TETA1Z)*SIN(TETA1X) 

D 1 32— COS  ( TETA  1 Z ) *S  I N ( TETA  1 Y ) *COS  ( TETA  1 X ) 
D13-D131+D132 

023 1 -COS ( TETA 1 Z ) *S I N ( TETA 1 X ) 

D232-S I N ( TETA 1 Z ) *S I N ( TETA 1 Y ) *COS ( TET A 1 X ) 
D23-D23 1 +D232 

033-COS ( TETA 1 Y ) *COS ( TETA1 X ) 

Fl-SIN(TETAY) 

F2— COS  ( TETA  Y ) *S  I N ( TETA  X ) 

F3-C0S ( TETAY ) *COS ( TETAX ) 

MATRIX  PD=P  X D 

PD1 1— (PI 1*D1 1 )+(P12*D21 >+(P13*D31 ) 
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C 


MIN! NVAR >=99999999.  99 


C 


1 


C 

900 


DO  1 1*2/ NUMBER 

TMPMAX-AMAX 1 ( ARRAY ( 1-1 >,  ARRAY ( I > ) 
MAX  < NVAR > -AMAX 1 ( MAX ( NVAR > , TMPMAX > 


TMPMIN-AMIN1 ( ARRAY! I-i > . ARRAY  < I > ) 

MIN ! NVAR  >—AMINl (MIN (NVAR ) « TMPMIN) 
CONTINUE 


NAME ( NVAR  > -NAMTMP 
RUN  < NVAR  > -RUNTMP 
UNITS ( NVAR  > -UNTTMP 
NUMB ( NVAR ) -NUMBER 


WRITE! 1« REC-1. ERR-900 ) NVAR . NAME* RUN.  MAX.  MIN.  UNITS.  NUMB 

WRITE! 1. REC— (NVAR+1 ) , ERR-900) ! ARRAY! I > . 1=1,  NUMBER  > 

RETURN 

NERROR-1 

RETURN 

END 


120  copies 
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